/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Scott Morrison, Floris van Doorn
-/
import category_theory.adjunction.basic
import category_theory.limits.cones
import category_theory.reflects_isomorphisms

/-!
# Limits and colimits

We set up the general theory of limits and colimits in a category.
In this introduction we only describe the setup for limits;
it is repeated, with slightly different names, for colimits.

The main structures defined in this file is
* `is_limit c`, for `c : cone F`, `F : J ⥤ C`, expressing that `c` is a limit cone,

See also `category_theory.limits.limits` which further builds:
* `limit_cone F`, which consists of a choice of cone for `F` and the fact it is a limit cone, and
* `has_limit F`, asserting the mere existence of some limit cone for `F`.

## Implementation
At present we simply say everything twice, in order to handle both limits and colimits.
It would be highly desirable to have some automation support,
e.g. a `@[dualize]` attribute that behaves similarly to `@[to_additive]`.

## References
* [Stacks: Limits and colimits](https://stacks.math.columbia.edu/tag/002D)

-/

noncomputable theory

open category_theory category_theory.category category_theory.functor opposite

namespace category_theory.limits

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C]

variables {F : J ⥤ C}

/--
A cone `t` on `F` is a limit cone if each cone on `F` admits a unique
cone morphism to `t`.

See https://stacks.math.columbia.edu/tag/002E.
  -/
@[nolint has_inhabited_instance]
structure is_limit (t : cone F) :=
(lift  : Π (s : cone F), s.X ⟶ t.X)
(fac'  : ∀ (s : cone F) (j : J), lift s ≫ t.π.app j = s.π.app j . obviously)
(uniq' : ∀ (s : cone F) (m : s.X ⟶ t.X) (w : ∀ j : J, m ≫ t.π.app j = s.π.app j),
  m = lift s . obviously)

restate_axiom is_limit.fac'
attribute [simp, reassoc] is_limit.fac
restate_axiom is_limit.uniq'

namespace is_limit

instance subsingleton {t : cone F} : subsingleton (is_limit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cone point
of any cone over `F` to the cone point of a limit cone over `G`. -/
def map {F G : J ⥤ C} (s : cone F) {t : cone G} (P : is_limit t)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.lift ((cones.postcompose α).obj s)

@[simp, reassoc] lemma map_π {F G : J ⥤ C} (c : cone F) {d : cone G} (hd : is_limit d)
  (α : F ⟶ G) (j : J) : hd.map c α ≫ d.π.app j = c.π.app j ≫ α.app j :=
fac _ _ _

lemma lift_self {c : cone F} (t : is_limit c) : t.lift c = 𝟙 c.X :=
(t.uniq _ _ (λ j, id_comp _)).symm

/- Repackaging the definition in terms of cone morphisms. -/

/-- The universal morphism from any other cone to a limit cone. -/
@[simps]
def lift_cone_morphism {t : cone F} (h : is_limit t) (s : cone F) : s ⟶ t :=
{ hom := h.lift s }

lemma uniq_cone_morphism {s t : cone F} (h : is_limit t) {f f' : s ⟶ t} :
  f = f' :=
have ∀ {g : s ⟶ t}, g = h.lift_cone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/--
Alternative constructor for `is_limit`,
providing a morphism of cones rather than a morphism between the cone points
and separately the factorisation condition.
-/
@[simps]
def mk_cone_morphism {t : cone F}
  (lift : Π (s : cone F), s ⟶ t)
  (uniq' : ∀ (s : cone F) (m : s ⟶ t), m = lift s) : is_limit t :=
{ lift := λ s, (lift s).hom,
  uniq' := λ s m w,
    have cone_morphism.mk m w = lift s, by apply uniq',
    congr_arg cone_morphism.hom this }

/-- Limit cones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s ≅ t :=
{ hom := Q.lift_cone_morphism s,
  inv := P.lift_cone_morphism t,
  hom_inv_id' := P.uniq_cone_morphism,
  inv_hom_id' := Q.uniq_cone_morphism }

/-- Any cone morphism between limit cones is an isomorphism. -/
lemma hom_is_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) (f : s ⟶ t) : is_iso f :=
⟨⟨P.lift_cone_morphism t, ⟨P.uniq_cone_morphism, Q.uniq_cone_morphism⟩⟩⟩

/-- Limits of `F` are unique up to isomorphism. -/
def cone_point_unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s.X ≅ t.X :=
(cones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma cone_point_unique_up_to_iso_hom_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).hom ≫ t.π.app j = s.π.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma cone_point_unique_up_to_iso_inv_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).inv ≫ s.π.app j = t.π.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_hom {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  P.lift r ≫ (cone_point_unique_up_to_iso P Q).hom = Q.lift r :=
Q.uniq _ _ (by simp)

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_inv {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  Q.lift r ≫ (cone_point_unique_up_to_iso P Q).inv = P.lift r :=
P.uniq _ _ (by simp)

/-- Transport evidence that a cone is a limit cone across an isomorphism of cones. -/
def of_iso_limit {r t : cone F} (P : is_limit r) (i : r ≅ t) : is_limit t :=
is_limit.mk_cone_morphism
  (λ s, P.lift_cone_morphism s ≫ i.hom)
  (λ s m, by rw ←i.comp_inv_eq; apply P.uniq_cone_morphism)

@[simp] lemma of_iso_limit_lift {r t : cone F} (P : is_limit r) (i : r ≅ t) (s) :
  (P.of_iso_limit i).lift s = P.lift s ≫ i.hom.hom :=
rfl

/-- Isomorphism of cones preserves whether or not they are limiting cones. -/
def equiv_iso_limit {r t : cone F} (i : r ≅ t) : is_limit r ≃ is_limit t :=
{ to_fun := λ h, h.of_iso_limit i,
  inv_fun := λ h, h.of_iso_limit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_limit_apply {r t : cone F} (i : r ≅ t) (P : is_limit r) :
  equiv_iso_limit i P = P.of_iso_limit i := rfl

@[simp] lemma equiv_iso_limit_symm_apply {r t : cone F} (i : r ≅ t) (P : is_limit t) :
  (equiv_iso_limit i).symm P = P.of_iso_limit i.symm := rfl

/--
If the canonical morphism from a cone point to a limiting cone point is an iso, then the
first cone was limiting also.
-/
def of_point_iso {r t : cone F} (P : is_limit r) [i : is_iso (P.lift t)] : is_limit t :=
of_iso_limit P
begin
  haveI : is_iso (P.lift_cone_morphism t).hom := i,
  haveI : is_iso (P.lift_cone_morphism t) := cones.cone_iso_of_hom_iso _,
  symmetry,
  apply as_iso (P.lift_cone_morphism t),
end

variables {t : cone F}

lemma hom_lift (h : is_limit t) {W : C} (m : W ⟶ t.X) :
  m = h.lift { X := W, π := { app := λ b, m ≫ t.π.app b } } :=
h.uniq { X := W, π := { app := λ b, m ≫ t.π.app b } } m (λ b, rfl)

/-- Two morphisms into a limit are equal if their compositions with
  each cone morphism are equal. -/
lemma hom_ext (h : is_limit t) {W : C} {f f' : W ⟶ t.X}
  (w : ∀ j, f ≫ t.π.app j = f' ≫ t.π.app j) : f = f' :=
by rw [h.hom_lift f, h.hom_lift f']; congr; exact funext w

/--
Given a right adjoint functor between categories of cones,
the image of a limit cone is a limit cone.
-/
def of_right_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ⥤ cone F) [is_right_adjoint h] {c : cone G} (t : is_limit c) :
  is_limit (h.obj c) :=
mk_cone_morphism
  (λ s, (adjunction.of_right_adjoint h).hom_equiv s c (t.lift_cone_morphism _))
  (λ s m, (adjunction.eq_hom_equiv_apply _ _ _).2 t.uniq_cone_morphism)

/--
Given two functors which have equivalent categories of cones, we can transport a limiting cone
across the equivalence.
-/
def of_cone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} :
  is_limit (h.functor.obj c) ≃ is_limit c :=
{ to_fun := λ P, of_iso_limit (of_right_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_right_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} (P : is_limit (h.functor.obj c)) (s) :
  (of_cone_equiv h P).lift s =
    ((h.unit_iso.hom.app s).hom ≫
      (h.functor.inv.map (P.lift_cone_morphism (h.functor.obj s))).hom) ≫
      (h.unit_iso.inv.app c).hom :=
rfl

@[simp]

/--
A cone postcomposed with a natural isomorphism is a limit cone if and only if the original cone is.
-/
def postcompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone F) :
  is_limit ((cones.postcompose α.hom).obj c) ≃ is_limit c :=
of_cone_equiv (cones.postcompose_equivalence α)

/--
A cone postcomposed with the inverse of a natural isomorphism is a limit cone if and only if
the original cone is.
-/
def postcompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone G) :
  is_limit ((cones.postcompose α.inv).obj c) ≃ is_limit c :=
postcompose_hom_equiv α.symm c

/--
The cone points of two limit cones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := Q.map s w.hom,
  inv := P.map t w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy), }

@[reassoc]
lemma cone_points_iso_of_nat_iso_hom_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).hom ≫ t.π.app j = s.π.app j ≫ w.hom.app j :=
by simp

@[reassoc]
lemma cone_points_iso_of_nat_iso_inv_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).inv ≫ s.π.app j = t.π.app j ≫ w.inv.app j :=
by simp

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {r s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) :
  P.lift r ≫ (cone_points_iso_of_nat_iso P Q w).hom = Q.map r w.hom :=
Q.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cone F} (P : is_limit s) (e : K ≌ J) :
  is_limit (s.whisker e.functor) :=
of_right_adjoint (cones.whiskering_equivalence e).functor P

/--
We can prove two cone points `(s : cone F).X` and `(t.cone F).X` are isomorphic if
* both cones are limit cones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cone_points_iso_of_equivalence {F : J ⥤ C} {s : cone F} {G : K ⥤ C} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := Q.lift ((cones.equivalence_of_reindexing e.symm w').functor.obj s),
  inv := P.lift ((cones.equivalence_of_reindexing e w).functor.obj t),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cone.whisker_π, limits.cones.postcompose_obj_π, fac, whisker_left_app,
      assoc, id_comp, inv_fun_id_assoc_hom_app, fac_assoc, nat_trans.comp_app],
    rw [counit_app_functor, ←functor.comp_map, w.hom.naturality],
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a limit cone: a map `W ⟶ X` is the same as
  a cone on `F` with vertex `W`. -/
def hom_iso (h : is_limit t) (W : C) : ulift.{u₁} (W ⟶ t.X : Type v₃) ≅ (const J).obj W ⟶ F :=
{ hom := λ f, (t.extend f.down).π,
  inv := λ π, ⟨h.lift { X := W, π := π }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_limit t) {W : C} (f : ulift.{u₁} (W ⟶ t.X)) :
  (is_limit.hom_iso h W).hom f = (t.extend f.down).π := rfl

/-- The limit of `F` represents the functor taking `W` to
  the set of cones on `F` with vertex `W`. -/
def nat_iso (h : is_limit t) : yoneda.obj t.X ⋙ ulift_functor.{u₁} ≅ F.cones :=
nat_iso.of_components (λ W, is_limit.hom_iso h (unop W)) (by tidy).

/--
Another, more explicit, formulation of the universal property of a limit cone.
See also `hom_iso`.
-/
def hom_iso' (h : is_limit t) (W : C) :
  ulift.{u₁} ((W ⟶ t.X) : Type v₃) ≅
    { p : Π j, W ⟶ F.obj j // ∀ {j j'} (f : j ⟶ j'), p j ≫ F.map f = p j' } :=
h.hom_iso W ≪≫
{ hom := λ π,
  ⟨λ j, π.app j, λ j j' f,
   by convert ←(π.naturality f).symm; apply id_comp⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [id_comp], exact (p.2 f).symm end } }

/-- If G : C → D is a faithful functor which sends t to a limit cone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_limit (G.map_cone t)) (lift : Π (s : cone F), s.X ⟶ t.X)
  (h : ∀ s, G.map (lift s) = ht.lift (G.map_cone s)) : is_limit t :=
{ lift := lift,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a limit implies
`G.map_cone c` is also a limit.
-/
def map_cone_equiv {D : Type u₄} [category.{v₄} D]
  {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G) {c : cone K}
  (t : is_limit (F.map_cone c)) : is_limit (G.map_cone c) :=
begin
  apply postcompose_inv_equiv (iso_whisker_left K h : _) (G.map_cone c) _,
  apply t.of_iso_limit (postcompose_whisker_left_map_cone h.symm c).symm,
end

/--
A cone is a limit cone exactly if
there is a unique cone morphism from any other cone.
-/
def iso_unique_cone_morphism {t : cone F} :
  is_limit t ≅ Π s, unique (s ⟶ t) :=
{ hom := λ h s,
  { default := h.lift_cone_morphism s,
    uniq := λ _, h.uniq_cone_morphism },
  inv := λ h,
  { lift := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones)

/-- If `F.cones` is represented by `X`, each morphism `f : Y ⟶ X` gives a cone with cone point
`Y`. -/
def cone_of_hom {Y : C} (f : Y ⟶ X) : cone F :=
{ X := Y, π := h.hom.app (op Y) ⟨f⟩ }

/-- If `F.cones` is represented by `X`, each cone `s` gives a morphism `s.X ⟶ X`. -/
def hom_of_cone (s : cone F) : s.X ⟶ X := (h.inv.app (op s.X) s.π).down

@[simp] lemma cone_of_hom_of_cone (s : cone F) : cone_of_hom h (hom_of_cone h s) = s :=
begin
  dsimp [cone_of_hom, hom_of_cone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) (op s_X)) s_π,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cone_of_hom {Y : C} (f : Y ⟶ X) : hom_of_cone h (cone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) (op Y)) ⟨f⟩ : _)

/-- If `F.cones` is represented by `X`, the cone corresponding to the identity morphism on `X`
will be a limit cone. -/
def limit_cone : cone F :=
cone_of_hom h (𝟙 X)

/-- If `F.cones` is represented by `X`, the cone corresponding to a morphism `f : Y ⟶ X` is
the limit cone extended by `f`. -/
lemma cone_of_hom_fac {Y : C} (f : Y ⟶ X) :
cone_of_hom h f = (limit_cone h).extend f :=
begin
  dsimp [cone_of_hom, limit_cone, cone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f.op) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [comp_id] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cones` is represented by `X`, any cone is the extension of the limit cone by the
corresponding morphism. -/
lemma cone_fac (s : cone F) : (limit_cone h).extend (hom_of_cone h s) = s :=
begin
  rw ←cone_of_hom_of_cone h s,
  conv_lhs { simp only [hom_of_cone_of_hom] },
  apply (cone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cones` is representable, then the cone corresponding to the identity morphism on
the representing object is a limit cone.
-/
def of_nat_iso {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones) :
  is_limit (limit_cone h) :=
{ lift := λ s, hom_of_cone h s,
  fac' := λ s j,
  begin
    have h := cone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cone_of_hom h m,
    congr,
    rw cone_of_hom_fac,
    dsimp [cone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_limit

/--
A cocone `t` on `F` is a colimit cocone if each cocone on `F` admits a unique
cocone morphism from `t`.

See https://stacks.math.columbia.edu/tag/002F.
-/
@[nolint has_inhabited_instance]
structure is_colimit (t : cocone F) :=
(desc  : Π (s : cocone F), t.X ⟶ s.X)
(fac'  : ∀ (s : cocone F) (j : J), t.ι.app j ≫ desc s = s.ι.app j . obviously)
(uniq' : ∀ (s : cocone F) (m : t.X ⟶ s.X) (w : ∀ j : J, t.ι.app j ≫ m = s.ι.app j),
  m = desc s . obviously)

restate_axiom is_colimit.fac'
attribute [simp,reassoc] is_colimit.fac
restate_axiom is_colimit.uniq'

namespace is_colimit

instance subsingleton {t : cocone F} : subsingleton (is_colimit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cocone point
of a colimit cocone over `F` to the cocone point of any cocone over `G`. -/
def map {F G : J ⥤ C} {s : cocone F} (P : is_colimit s) (t : cocone G)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.desc ((cocones.precompose α).obj t)

@[simp, reassoc]
lemma ι_map {F G : J ⥤ C} {c : cocone F} (hc : is_colimit c) (d : cocone G) (α : F ⟶ G)
  (j : J) : c.ι.app j ≫ is_colimit.map hc d α = α.app j ≫ d.ι.app j :=
fac _ _ _

@[simp]
lemma desc_self {t : cocone F} (h : is_colimit t) : h.desc t = 𝟙 t.X :=
(h.uniq _ _ (λ j, comp_id _)).symm

/- Repackaging the definition in terms of cocone morphisms. -/

/-- The universal morphism from a colimit cocone to any other cocone. -/
@[simps]
def desc_cocone_morphism {t : cocone F} (h : is_colimit t) (s : cocone F) : t ⟶ s :=
{ hom := h.desc s }

lemma uniq_cocone_morphism {s t : cocone F} (h : is_colimit t) {f f' : t ⟶ s} :
  f = f' :=
have ∀ {g : t ⟶ s}, g = h.desc_cocone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/--
Alternative constructor for `is_colimit`,
providing a morphism of cocones rather than a morphism between the cocone points
and separately the factorisation condition.
-/
@[simps]
def mk_cocone_morphism {t : cocone F}
  (desc : Π (s : cocone F), t ⟶ s)
  (uniq' : ∀ (s : cocone F) (m : t ⟶ s), m = desc s) : is_colimit t :=
{ desc := λ s, (desc s).hom,
  uniq' := λ s m w,
    have cocone_morphism.mk m w = desc s, by apply uniq',
    congr_arg cocone_morphism.hom this }

/-- Colimit cocones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) : s ≅ t :=
{ hom := P.desc_cocone_morphism t,
  inv := Q.desc_cocone_morphism s,
  hom_inv_id' := P.uniq_cocone_morphism,
  inv_hom_id' := Q.uniq_cocone_morphism }

/-- Any cocone morphism between colimit cocones is an isomorphism. -/
lemma hom_is_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) (f : s ⟶ t) : is_iso f :=
⟨⟨Q.desc_cocone_morphism s, ⟨P.uniq_cocone_morphism, Q.uniq_cocone_morphism⟩⟩⟩

/-- Colimits of `F` are unique up to isomorphism. -/
def cocone_point_unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) :
  s.X ≅ t.X :=
(cocones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_hom {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : s.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).hom = t.ι.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_inv {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : t.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).inv = s.ι.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_hom_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).hom ≫ Q.desc r = P.desc r :=
P.uniq _ _ (by simp)

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_inv_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).inv ≫ P.desc r = Q.desc r :=
Q.uniq _ _ (by simp)

/-- Transport evidence that a cocone is a colimit cocone across an isomorphism of cocones. -/
def of_iso_colimit {r t : cocone F} (P : is_colimit r) (i : r ≅ t) : is_colimit t :=
is_colimit.mk_cocone_morphism
  (λ s, i.inv ≫ P.desc_cocone_morphism s)
  (λ s m, by rw i.eq_inv_comp; apply P.uniq_cocone_morphism)

@[simp] lemma of_iso_colimit_desc {r t : cocone F} (P : is_colimit r) (i : r ≅ t) (s) :
  (P.of_iso_colimit i).desc s = i.inv.hom ≫ P.desc s :=
rfl

/-- Isomorphism of cocones preserves whether or not they are colimiting cocones. -/
def equiv_iso_colimit {r t : cocone F} (i : r ≅ t) : is_colimit r ≃ is_colimit t :=
{ to_fun := λ h, h.of_iso_colimit i,
  inv_fun := λ h, h.of_iso_colimit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_colimit_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit r) :
  equiv_iso_colimit i P = P.of_iso_colimit i := rfl

@[simp] lemma equiv_iso_colimit_symm_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit t) :
  (equiv_iso_colimit i).symm P = P.of_iso_colimit i.symm := rfl

/--
If the canonical morphism to a cocone point from a colimiting cocone point is an iso, then the
first cocone was colimiting also.
-/
def of_point_iso {r t : cocone F} (P : is_colimit r) [i : is_iso (P.desc t)] : is_colimit t :=
of_iso_colimit P
begin
  haveI : is_iso (P.desc_cocone_morphism t).hom := i,
  haveI : is_iso (P.desc_cocone_morphism t) := cocones.cocone_iso_of_hom_iso _,
  apply as_iso (P.desc_cocone_morphism t),
end

variables {t : cocone F}

lemma hom_desc (h : is_colimit t) {W : C} (m : t.X ⟶ W) :
  m = h.desc { X := W, ι := { app := λ b, t.ι.app b ≫ m,
    naturality' := by intros; erw [←assoc, t.ι.naturality, comp_id, comp_id] } } :=
h.uniq { X := W, ι := { app := λ b, t.ι.app b ≫ m, naturality' := _ } } m (λ b, rfl)

/-- Two morphisms out of a colimit are equal if their compositions with
  each cocone morphism are equal. -/
lemma hom_ext (h : is_colimit t) {W : C} {f f' : t.X ⟶ W}
  (w : ∀ j, t.ι.app j ≫ f = t.ι.app j ≫ f') : f = f' :=
by rw [h.hom_desc f, h.hom_desc f']; congr; exact funext w

/--
Given a left adjoint functor between categories of cocones,
the image of a colimit cocone is a colimit cocone.
-/
def of_left_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ⥤ cocone F) [is_left_adjoint h] {c : cocone G} (t : is_colimit c) :
  is_colimit (h.obj c) :=
mk_cocone_morphism
  (λ s, ((adjunction.of_left_adjoint h).hom_equiv c s).symm (t.desc_cocone_morphism _))
  (λ s m, (adjunction.hom_equiv_apply_eq _ _ _).1 t.uniq_cocone_morphism)

/--
Given two functors which have equivalent categories of cocones,
we can transport a colimiting cocone across the equivalence.
-/
def of_cocone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} :
  is_colimit (h.functor.obj c) ≃ is_colimit c :=
{ to_fun := λ P, of_iso_colimit (of_left_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_left_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cocone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit (h.functor.obj c)) (s) :
  (of_cocone_equiv h P).desc s =
    (h.unit.app c).hom ≫
    (h.inverse.map (P.desc_cocone_morphism (h.functor.obj s))).hom ≫
    (h.unit_inv.app s).hom :=
rfl

@[simp] lemma of_cocone_equiv_symm_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit c) (s) :
  ((of_cocone_equiv h).symm P).desc s =
    (h.functor.map (P.desc_cocone_morphism (h.inverse.obj s))).hom ≫ (h.counit.app s).hom :=
rfl

/--
A cocone precomposed with a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone G) :
  is_colimit ((cocones.precompose α.hom).obj c) ≃ is_colimit c :=
of_cocone_equiv (cocones.precompose_equivalence α)

/--
A cocone precomposed with the inverse of a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) :
  is_colimit ((cocones.precompose α.inv).obj c) ≃ is_colimit c :=
precompose_hom_equiv α.symm c

/--
The cocone points of two colimit cocones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cocone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := P.map t w.hom,
  inv := Q.map s w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy) }

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  s.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).hom = w.hom.app j ≫ t.ι.app j :=
by simp

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  t.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).inv = w.inv.app j ≫ s.ι.app j :=
by simp

@[reassoc]
lemma cocone_points_iso_of_nat_iso_hom_desc {F G : J ⥤ C} {s : cocone F} {r t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).hom ≫ Q.desc r = P.map _ w.hom :=
P.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cocone F} (P : is_colimit s) (e : K ≌ J) :
  is_colimit (s.whisker e.functor) :=
of_left_adjoint (cocones.whiskering_equivalence e).functor P

/--
We can prove two cocone points `(s : cocone F).X` and `(t.cocone F).X` are isomorphic if
* both cocones are colimit ccoones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cocone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cocone_points_iso_of_equivalence {F : J ⥤ C} {s : cocone F} {G : K ⥤ C} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := P.desc ((cocones.equivalence_of_reindexing e w).functor.obj t),
  inv := Q.desc ((cocones.equivalence_of_reindexing e.symm w').functor.obj s),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cocone.whisker_ι, fac, inv_fun_id_assoc_inv_app, whisker_left_app, assoc,
      comp_id, limits.cocones.precompose_obj_ι, fac_assoc, nat_trans.comp_app],
    rw [counit_inv_app_functor, ←functor.comp_map, ←w.inv.naturality_assoc],
    dsimp,
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a colimit cocone: a map `X ⟶ W` is the same as
  a cocone on `F` with vertex `W`. -/
def hom_iso (h : is_colimit t) (W : C) : ulift.{u₁} (t.X ⟶ W : Type v₃) ≅ (F ⟶ (const J).obj W) :=
{ hom := λ f, (t.extend f.down).ι,
  inv := λ ι, ⟨h.desc { X := W, ι := ι }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_colimit t) {W : C} (f : ulift (t.X ⟶ W)) :
  (is_colimit.hom_iso h W).hom f = (t.extend f.down).ι := rfl

/-- The colimit of `F` represents the functor taking `W` to
  the set of cocones on `F` with vertex `W`. -/
def nat_iso (h : is_colimit t) : coyoneda.obj (op t.X) ⋙ ulift_functor.{u₁} ≅ F.cocones :=
nat_iso.of_components (is_colimit.hom_iso h) (by intros; ext; dsimp; rw ←assoc; refl)

/--
Another, more explicit, formulation of the universal property of a colimit cocone.
See also `hom_iso`.
-/
def hom_iso' (h : is_colimit t) (W : C) :
  ulift.{u₁} ((t.X ⟶ W) : Type v₃) ≅
    { p : Π j, F.obj j ⟶ W // ∀ {j j' : J} (f : j ⟶ j'), F.map f ≫ p j' = p j } :=
h.hom_iso W ≪≫
{ hom := λ ι,
  ⟨λ j, ι.app j, λ j j' f,
   by convert ←(ι.naturality f); apply comp_id⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [comp_id], exact (p.2 f) end } }

/-- If G : C → D is a faithful functor which sends t to a colimit cocone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cocone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_colimit (G.map_cocone t)) (desc : Π (s : cocone F), t.X ⟶ s.X)
  (h : ∀ s, G.map (desc s) = ht.desc (G.map_cocone s)) : is_colimit t :=
{ desc := desc,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cocone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a colimit implies
`G.map_cone c` is also a colimit.
-/
def map_cocone_equiv {D : Type u₄} [category.{v₄} D] {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G)
  {c : cocone K} (t : is_colimit (F.map_cocone c)) : is_colimit (G.map_cocone c) :=
begin
  apply is_colimit.of_iso_colimit _ (precompose_whisker_left_map_cocone h c),
  apply (precompose_inv_equiv (iso_whisker_left K h : _) _).symm t,
end

/--
A cocone is a colimit cocone exactly if
there is a unique cocone morphism from any other cocone.
-/
def iso_unique_cocone_morphism {t : cocone F} :
  is_colimit t ≅ Π s, unique (t ⟶ s) :=
{ hom := λ h s,
  { default := h.desc_cocone_morphism s,
    uniq := λ _, h.uniq_cocone_morphism },
  inv := λ h,
  { desc := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cocone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones)

/-- If `F.cocones` is corepresented by `X`, each morphism `f : X ⟶ Y` gives a cocone with cone
point `Y`. -/
def cocone_of_hom {Y : C} (f : X ⟶ Y) : cocone F :=
{ X := Y, ι := h.hom.app Y ⟨f⟩ }

/-- If `F.cocones` is corepresented by `X`, each cocone `s` gives a morphism `X ⟶ s.X`. -/
def hom_of_cocone (s : cocone F) : X ⟶ s.X := (h.inv.app s.X s.ι).down

@[simp] lemma cocone_of_hom_of_cocone (s : cocone F) : cocone_of_hom h (hom_of_cocone h s) = s :=
begin
  dsimp [cocone_of_hom, hom_of_cocone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) s_X) s_ι,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cocone_of_hom {Y : C} (f : X ⟶ Y) : hom_of_cocone h (cocone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) Y) ⟨f⟩ : _)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to the identity morphism on `X`
will be a colimit cocone. -/
def colimit_cocone : cocone F :=
cocone_of_hom h (𝟙 X)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to a morphism `f : Y ⟶ X` is
the colimit cocone extended by `f`. -/
lemma cocone_of_hom_fac {Y : C} (f : X ⟶ Y) :
cocone_of_hom h f = (colimit_cocone h).extend f :=
begin
  dsimp [cocone_of_hom, colimit_cocone, cocone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [id_comp] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cocones` is corepresented by `X`, any cocone is the extension of the colimit cocone by the
corresponding morphism. -/
lemma cocone_fac (s : cocone F) : (colimit_cocone h).extend (hom_of_cocone h s) = s :=
begin
  rw ←cocone_of_hom_of_cocone h s,
  conv_lhs { simp only [hom_of_cocone_of_hom] },
  apply (cocone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cocones` is corepresentable, then the cocone corresponding to the identity morphism on
the representing object is a colimit cocone.
-/
def of_nat_iso {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones) :
  is_colimit (colimit_cocone h) :=
{ desc := λ s, hom_of_cocone h s,
  fac' := λ s j,
  begin
    have h := cocone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cocone_of_hom h m,
    congr,
    rw cocone_of_hom_fac,
    dsimp [cocone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_colimit

end category_theory.limits


import analysis.inner_product_space.adjoint

variables {𝕜 E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E] [complete_space E]

open_locale big_operators matrix topological_space

lemma seq_unitary_tendsto_unitary {U : ℕ → (E →L[𝕜] E)} {L : (E →L[𝕜] E)}
  (hU : ∀ (i : ℕ), U i ∈ unitary (E →L[𝕜] E)) (hL : filter.tendsto U filter.at_top (𝓝 L)) :
  L ∈ unitary (E →L[𝕜] E) :=
begin
  rw unitary.mem_iff,
  have h_star : filter.tendsto (star U) filter.at_top (𝓝 (star L)) :=
    @filter.tendsto.star _ _ _ _ _ U filter.at_top L hL,
  have tendsto_starLL : filter.tendsto ((star U) * U) filter.at_top (𝓝 ((star L) * L)) :=
    @filter.tendsto.mul _ _ _ _ _ _ _ _ _ _ h_star hL,
  have tendsto_LstarL : filter.tendsto (U * (star U)) filter.at_top (𝓝 (L * (star L))) :=
    @filter.tendsto.mul _ _ _ _ _ _ _ _ _ _ hL h_star,
  have h_starLL : filter.tendsto ((star U) * U) filter.at_top (𝓝 (1)) :=
  begin
    intros s h,
    simp only [filter.mem_at_top_sets, filter.mem_map],
    use 0,
    intros b h_b,
    simp only [set.mem_preimage, pi.mul_apply, pi.star_apply, unitary.star_mul_self_of_mem],
    apply mem_of_mem_nhds,
    have : star (U b) * (U b) = 1 :=
    begin
      specialize hU b,
      rw unitary.mem_iff at hU,
      exact hU.1,
    end,
    rw this,
    exact h,
  end,
  have h_LstarL : filter.tendsto (U * (star U)) filter.at_top (𝓝 (1)) :=
  begin
    intros s h,
    simp only [filter.mem_at_top_sets, filter.mem_map],
    use 0,
    intros b h_b,
    simp only [set.mem_preimage, pi.mul_apply, pi.star_apply, unitary.star_mul_self_of_mem],
    apply mem_of_mem_nhds,
    have : (U b) * star (U b) = 1 :=
    begin
      specialize hU b,
      rw unitary.mem_iff at hU,
      exact hU.2,
    end,
    rw this,
    exact h,
  end,
  have lim_LstarL : lim filter.at_top (U * (star U)) = L * (star L) :=
    filter.tendsto.lim_eq tendsto_LstarL,
  have lim_starLL : lim filter.at_top ((star U) * U) = (star L) * L :=
    filter.tendsto.lim_eq tendsto_starLL,
  have lim_one : lim filter.at_top (U * (star U)) = 1 := filter.tendsto.lim_eq h_LstarL,
  have lim_two : lim filter.at_top ((star U) * U) = 1 := filter.tendsto.lim_eq h_starLL,
  rw [← lim_LstarL, ← lim_starLL],
  split,
  exact lim_two,
  exact lim_one,
end


import caseI.aux_lemmas

open finset nat is_cyclotomic_extension ideal polynomial int basis flt_regular.caseI

open_locale big_operators number_field

namespace flt_regular

variables {p : ℕ} [hpri : fact p.prime]

local notation `P` := (⟨p, hpri.out.pos⟩ : ℕ+)
local notation `K` := cyclotomic_field P ℚ
local notation `R` := 𝓞 K

namespace caseI

/-- Statement of case I with additional assumptions. -/
def slightly_easier : Prop := ∀ ⦃a b c : ℤ⦄ {p : ℕ} [hpri : fact p.prime]
  (hreg : @is_regular_prime p hpri) (hp5 : 5 ≤ p)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1)
  (hab : ¬a ≡ b [ZMOD p]) (caseI : ¬ ↑p ∣ a * b * c), a ^ p + b ^ p ≠ c ^ p

/-- Statement of case I. -/
def statement : Prop := ∀ ⦃a b c : ℤ⦄ {p : ℕ} [hpri : fact p.prime]
  (hreg : @is_regular_prime p hpri) (caseI : ¬ ↑p ∣ a * b * c),
  a ^ p + b ^ p ≠ c ^ p

lemma may_assume : slightly_easier → statement :=
begin
  intro Heasy,
  intros a b c p hpri hreg hI H,
  have hodd : p ≠ 2,
  { intro h,
    rw [h] at H hI,
    refine hI _,
    refine has_dvd.dvd.mul_left _ _,
    simp only [coe_nat_bit0, algebra_map.coe_one, ← even_iff_two_dvd] at ⊢ hI,
    rw [← int.odd_iff_not_even] at hI,
    rw [← int.even_pow' (show 2 ≠ 0, by norm_num), ← H],
    exact (odd.of_mul_left (odd.of_mul_left hI)).pow.add_odd
      (odd.of_mul_right (odd.of_mul_left hI)).pow },
  have hprod : a * b * c ≠ 0,
  { intro h,
    simpa [h] using hI },
  have hp5 : 5 ≤ p,
  { by_contra' habs,
    have : p ∈ finset.Ioo 2 5 := finset.mem_Icc.2 ⟨nat.lt_of_le_and_ne hpri.out.two_le hodd.symm,
      by linarith⟩,
    fin_cases this,
    { exact may_assume.p_ne_three hprod H rfl },
    { rw [show 4 = 2 * 2, from rfl] at hpri,
      refine nat.not_prime_mul one_lt_two one_lt_two hpri.out } },
  rcases may_assume.coprime H hprod with ⟨Hxyz, hunit, hprodxyx⟩,
  let d := ({a, b, c} : finset ℤ).gcd id,
  have hdiv : ¬↑p ∣ (a / d) * (b / d) * (c / d),
  { have hadiv : d ∣ a := gcd_dvd (by simp),
    have hbdiv : d ∣ b := gcd_dvd (by simp),
    have hcdiv : d ∣ c := gcd_dvd (by simp),
    intro hdiv,
    replace hdiv := dvd_mul_of_dvd_right hdiv ((d * d) * d),
    rw [mul_assoc, ← mul_assoc d, ← mul_assoc d, int.mul_div_cancel' hadiv, mul_assoc,
      mul_comm a, mul_assoc (b / d), ← mul_assoc _ (b / d), int.mul_div_cancel' hbdiv,
      mul_comm, mul_assoc, mul_assoc, int.div_mul_cancel hcdiv, mul_comm, mul_assoc,
      mul_comm c, ← mul_assoc] at hdiv,
    exact hI hdiv },
  obtain ⟨X, Y, Z, H1, H2, H3, H4, H5⟩ := a_not_cong_b hpri.out hp5 hprodxyx Hxyz hunit hdiv,
  exactI Heasy hreg hp5 H2 H3 (λ hfin, H5 hfin) H1
end

end caseI

lemma ab_coprime {a b c : ℤ} (H : a ^ p + b ^ p = c ^ p) (hpzero : p ≠ 0)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1) : is_coprime a b  :=
begin
  rw [← gcd_eq_one_iff_coprime],
  by_contra' h,
  obtain ⟨q, hqpri, hq⟩ := exists_prime_and_dvd h,
  replace hqpri : prime (q : ℤ) := prime_iff_nat_abs_prime.2 (by simp [hqpri]),
  obtain ⟨n, hn⟩ := hq,
  have haq : ↑q ∣ a,
  { obtain ⟨m, hm⟩ := int.gcd_dvd_left a b,
    exact ⟨n * m, by { rw [hm, hn], simp [mul_assoc] }⟩ },
  have hbq : ↑q ∣ b,
  { obtain ⟨m, hm⟩ := int.gcd_dvd_right a b,
    exact ⟨n * m, by { rw [hm, hn], simp [mul_assoc] }⟩ },
  have hcq : ↑q ∣ c,
  { suffices : ↑q ∣ c ^ p,
    { exact hqpri.dvd_of_dvd_pow this },
    rw [← H],
    exact dvd_add (dvd_pow haq hpzero) (dvd_pow hbq hpzero) },
  have Hq : ↑q ∣ ({a, b, c} : finset ℤ).gcd id,
  { refine dvd_gcd (λ x hx, _),
    simp only [mem_insert, mem_singleton] at hx,
    rcases hx with H | H | H;
    simpa [H] },
  rw [hgcd] at Hq,
  exact hqpri.not_unit (is_unit_of_dvd_one _ Hq)
end

theorem exists_ideal {a b c : ℤ} (h5p : 5 ≤ p) (H : a ^ p + b ^ p = c ^ p)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1) (caseI : ¬ ↑p ∣ a * b * c)
  {ζ : R} (hζ : ζ ∈ nth_roots_finset p R) : ∃ I, span ({a + ζ * b} : set R) = I ^ p :=
begin
  haveI : fact ((P : ℕ).prime) := ⟨hpri.out⟩,
  classical,
  have H₁ := congr_arg (algebra_map ℤ R) H,
  simp only [eq_int_cast, int.cast_add, int.cast_pow] at H₁,
  have hζ' := (zeta_spec P ℚ K).unit'_coe,
  rw [pow_add_pow_eq_prod_add_zeta_runity_mul
      (hpri.out.eq_two_or_odd.resolve_left $ λ h, by norm_num [h] at h5p) hζ'] at H₁,
  replace H₁ := congr_arg (λ x, span ({x} : set R)) H₁,
  simp only [← prod_span_singleton, ← span_singleton_pow] at H₁,
  obtain ⟨I, hI⟩ := finset.exists_eq_pow_of_mul_eq_pow_of_coprime (λ η₁ hη₁ η₂ hη₂ hη, _) H₁ ζ hζ,
  { exact ⟨I, hI⟩ },
  { exact flt_ideals_coprime h5p H (ab_coprime H hpri.out.ne_zero hgcd) hη₁ hη₂ hη caseI }
end

theorem is_principal {a b c : ℤ} {ζ : R} (hreg : is_regular_prime p) (hp5 : 5 ≤ p)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1) (caseI : ¬ ↑p ∣ a * b * c)
  (H : a ^ p + b ^ p = c ^ p) (hζ : is_primitive_root ζ p) :
  ∃ (u : Rˣ) (α : R), ↑u * (α ^ p) = ↑a + ζ * ↑b :=
begin
  replace hζ := hζ.mem_nth_roots_finset hpri.out.pos,
  obtain ⟨I, hI⟩ := exists_ideal hp5 H hgcd caseI hζ,
  by_cases hIpzero : I ^ p = 0,
  { refine ⟨1, 0, _⟩,
    simp [hIpzero, zero_eq_bot, span_singleton_eq_bot] at hI,
    simp [hpri.out.pos, hI] },
  have hIzero : I ≠ 0,
  { intro hIzero,
    simp only [hIzero, zero_pow hpri.out.pos] at hIpzero,
    exact hIpzero rfl },
  have hIprin : I.is_principal,
  { have : class_group.mk0 ⟨_, mem_non_zero_divisors_of_ne_zero hIpzero⟩ = 1,
    { rw [class_group.mk0_eq_one_iff (mem_non_zero_divisors_of_ne_zero hIpzero)],
      exact ⟨⟨↑a + ζ * ↑b, hI.symm⟩⟩ },
    rw [← submonoid_class.mk_pow I (mem_non_zero_divisors_of_ne_zero hIzero), map_pow] at this,
    cases (dvd_prime hpri.out).1 (order_of_dvd_of_pow_eq_one this) with h1 habs,
    { exact (class_group.mk0_eq_one_iff _).1 (order_of_eq_one_iff.1 h1) },
    { exfalso,
      refine hpri.out.coprime_iff_not_dvd.1 hreg _,
      simp_rw [← habs],
      exact order_of_dvd_card_univ, } },
  obtain ⟨α, hα⟩ := hIprin,
  replace hα := congr_arg (λ J, J ^ p) hα,
  simp only [←hI, submodule_span_eq, span_singleton_pow, span_singleton_eq_span_singleton] at hα,
  obtain ⟨u, hu⟩ := hα,
  refine ⟨u⁻¹, α, _⟩,
  rw [← hu, mul_comm _ ↑u, ← mul_assoc],
  simp
end

theorem ex_fin_div {a b c : ℤ} {ζ : R} (hp5 : 5 ≤ p)
  (hreg : is_regular_prime p) (hζ : is_primitive_root ζ p)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1) (caseI : ¬ ↑p ∣ a * b * c)
  (H : a ^ p + b ^ p = c ^ p) :
  ∃ (k₁ k₂ : fin p), k₂ ≡ k₁ - 1 [ZMOD p] ∧ ↑p ∣ ↑a + ↑b * ζ - ↑a * ζ ^ (k₁ : ℕ) - ↑b * ζ ^ (k₂ : ℕ) :=
begin
  let ζ' := (ζ : K),
  have hζ' : is_primitive_root ζ' P := is_primitive_root.coe_submonoid_class_iff.2 hζ,
  have : ζ = (hζ'.unit' : R) := by simp only [is_primitive_root.unit', set_like.eta, units.coe_mk],
  have hP : P ≠ 2,
  { intro hP,
    rw [← pnat.coe_inj, pnat.mk_coe, pnat.coe_bit0, pnat.one_coe] at hP,
    norm_num [hP] at hp5 },
  haveI := (⟨hpri.out⟩ : fact ((P : ℕ).prime)),
  haveI diamond : is_cyclotomic_extension {P} ℚ K := cyclotomic_field.is_cyclotomic_extension P ℚ,
  obtain ⟨u, α, hu⟩ := is_principal hreg hp5 hgcd caseI H hζ,
  rw [this, mul_comm _ ↑b, ← pow_one hζ'.unit'] at hu,
  obtain ⟨k, hk⟩ := @flt_regular.caseI.exists_int_sum_eq_zero P K _ _
    (by {convert diamond, by exact subsingleton.elim _ _ }) ζ hζ' hP _ a b 1 u α hu.symm,
  simp only [zpow_one, zpow_neg, coe_coe, pnat.mk_coe, mem_span_singleton, ← this] at hk,
  have hpcoe : (p : ℤ) ≠ 0 := by simp [hpri.out.ne_zero],
  refine ⟨⟨(2 * k % p).nat_abs, _⟩, ⟨((2 * k - 1) % p).nat_abs, _⟩, _, _⟩,
  repeat { rw [← nat_abs_of_nat p],
    refine nat_abs_lt_nat_abs_of_nonneg_of_lt (mod_nonneg _ hpcoe) _,
    rw [nat_abs_of_nat],
    exact mod_lt_of_pos _ (by simp [hpri.out.pos]) },
  { simp [nat_abs_of_nonneg (mod_nonneg _ hpcoe), ← zmod.int_coe_eq_int_coe_iff] },
  simp only [add_sub_assoc, sub_sub] at hk ⊢,
  convert hk using 3,
  rw [mul_add, mul_comm ↑a, ← mul_assoc _ ↑b, mul_comm _ ↑b, mul_assoc ↑b],
  congr' 2,
  { rw [← subtype.coe_inj],
    simp only [fin.coe_mk, subsemiring_class.coe_pow, _root_.coe_zpow', coe_coe,
      is_primitive_root.coe_unit'_coe],
    refine eq_of_div_eq_one _,
    rw [← zpow_coe_nat, ← zpow_sub₀ (hζ'.ne_zero hpri.out.ne_zero), hζ'.zpow_eq_one_iff_dvd],
    simp [nat_abs_of_nonneg (mod_nonneg _ hpcoe), ← zmod.int_coe_zmod_eq_zero_iff_dvd] },
  { rw [← subtype.coe_inj],
    simp only [fin.coe_mk, subsemiring_class.coe_pow, mul_mem_class.coe_mul, _root_.coe_zpow',
      coe_coe, is_primitive_root.coe_unit'_coe, is_primitive_root.coe_inv_unit'_coe],
    refine eq_of_div_eq_one _,
    rw [← zpow_coe_nat, ← zpow_sub_one₀ (hζ'.ne_zero hpri.out.ne_zero),
      ← zpow_sub₀ (hζ'.ne_zero hpri.out.ne_zero), hζ'.zpow_eq_one_iff_dvd, pnat.mk_coe],
    simp [nat_abs_of_nonneg (mod_nonneg _ hpcoe), ← zmod.int_coe_zmod_eq_zero_iff_dvd] },
end

/-- Auxiliary function -/
def f (a b : ℤ) (k₁ k₂ : ℕ) : ℕ → ℤ := λ x, if x = 0 then a else if x = 1 then b else
  if x = k₁ then -a else if x = k₂ then -b else 0

lemma auxf' (hp5 : 5 ≤ p) (a b : ℤ) (k₁ k₂ : fin p) : ∃ i ∈ range p, f a b k₁ k₂ (i : ℕ) = 0 :=
begin
  have h0 : 0 < p := by linarith,
  have h1 : 1 < p := by linarith,
  let s := ({0, 1, k₁, k₂} : finset ℕ),
  have : s.card ≤ 4,
  { repeat { refine le_trans (card_insert_le _ _) (succ_le_succ _) },
    exact rfl.ge },
  replace this : s.card < 5 := lt_of_le_of_lt this (by norm_num),
  have hs : s ⊆ range p := insert_subset.2 ⟨mem_range.2 h0, insert_subset.2 ⟨mem_range.2 h1,
    insert_subset.2 ⟨mem_range.2 (fin.is_lt _), singleton_subset_iff.2 (mem_range.2 (fin.is_lt _))⟩⟩⟩,
  have hcard := card_sdiff hs,
  replace hcard : (range p \ s).nonempty,
  { rw [← card_pos, hcard, card_range],
    exact nat.sub_pos_of_lt (lt_of_lt_of_le this hp5) },
  obtain ⟨i, hi⟩ := hcard,
  refine ⟨i, sdiff_subset _ _ hi, _⟩,
  have hi0 : i ≠ 0 := λ h, by simpa [h] using hi,
  have hi1 : i ≠ 1 := λ h, by simpa [h] using hi,
  have hik₁ : i ≠ k₁ := λ h, by simpa [h] using hi,
  have hik₂ : i ≠ k₂ := λ h, by simpa [h] using hi,
  simp [f, hi0, hi1, hik₁, hik₂]
end

lemma auxf (hp5 : 5 ≤ p) (a b : ℤ) (k₁ k₂ : fin p) : ∃ i : fin p, f a b k₁ k₂ (i : ℕ) = 0 :=
begin
  obtain ⟨i, hrange, hi⟩ := auxf' hp5 a b k₁ k₂,
  exact ⟨⟨i, mem_range.1 hrange⟩, hi⟩
end

local attribute [-instance] cyclotomic_field.algebra

/-- Case I with additional assumptions. -/
theorem caseI_easier {a b c : ℤ} (p : ℕ) [hpri : fact p.prime]
  (hreg : is_regular_prime p) (hp5 : 5 ≤ p)
  (hgcd : ({a, b, c} : finset ℤ).gcd id = 1)
  (hab : ¬a ≡ b [ZMOD p]) (caseI : ¬ ↑p ∣ a * b * c) : a ^ p + b ^ p ≠ c ^ p :=
begin
  haveI := (⟨hpri.out⟩ : fact ((P : ℕ).prime)),
  haveI diamond : is_cyclotomic_extension {P} ℚ K,
  { convert cyclotomic_field.is_cyclotomic_extension P ℚ,
    exact subsingleton.elim _ _ },
  set ζ := zeta P ℤ R with hζdef,
  have hζ := zeta_spec P ℤ R,

  intro H,
  obtain ⟨k₁, k₂, hcong, hdiv⟩ := ex_fin_div hp5 hreg hζ hgcd caseI H,
  have key : ↑(p : ℤ) ∣ ∑ j in range p, (f a b k₁ k₂ j) • ζ ^ j,
  { convert hdiv using 1,
    { simp },
    have h01 : 0 ≠ 1 := zero_ne_one,
    have h0k₁ : 0 ≠ ↑k₁ := aux0k₁ hpri.out hp5 hζ caseI hcong hdiv,
    have h0k₂ : 0 ≠ ↑k₂ := aux0k₂ hpri.out hp5 hζ hab hcong hdiv,
    have h1k₁ : 1 ≠ ↑k₁ := aux1k₁ hpri.out hp5 hζ hab hcong hdiv,
    have h1k₂ : 1 ≠ ↑k₂ := aux1k₂ hpri.out hp5 hζ caseI hcong hdiv,
    have hk₁k₂ : (k₁ : ℕ) ≠ (k₂ : ℕ) := auxk₁k₂ hpri.out hcong,
    simp_rw [f, ite_smul, sum_ite, filter_filter, ← ne.def, ne_and_eq_iff_right h01,
      and_assoc, ne_and_eq_iff_right h1k₁, ne_and_eq_iff_right h0k₁, ne_and_eq_iff_right hk₁k₂,
      ne_and_eq_iff_right h1k₂, ne_and_eq_iff_right h0k₂, finset.range_filter_eq],
    simp only [hpri.out.pos, hpri.out.one_lt, if_true, zsmul_eq_mul, sum_singleton, pow_zero,
      mul_one, pow_one, fin.is_lt, neg_smul, sum_neg_distrib, ne.def, filter_congr_decidable, zero_smul, sum_const_zero, add_zero],
    ring },
  rw [sum_range] at key,
  refine caseI (has_dvd.dvd.mul_right (has_dvd.dvd.mul_right _ _) _),
  simpa [f] using dvd_coeff_cycl_integer hζ (by exact auxf hp5 a b k₁ k₂) key ⟨0, hpri.out.pos⟩
end

/-- CaseI. -/
theorem caseI {a b c : ℤ} {p : ℕ} [fact p.prime] (hreg : is_regular_prime p)
  (caseI : ¬ ↑p ∣ a * b * c) : a ^ p + b ^ p ≠ c ^ p :=
flt_regular.caseI.may_assume (λ x y z p₁ Hpri Hreg Hp5 Hunit Hxy HI H,
  by exactI caseI_easier p₁ Hreg Hp5 Hunit Hxy HI H) hreg caseI

end flt_regular


import Mathlib.Tactic.Linarith
import ECTate.Data.Nat.Enat
open Qq Lean Meta Tactic Mathlib.Tactic.Ring

def is_atom (e : Expr) : Mathlib.Tactic.AtomM Bool :=
  fun rctx ↦ do
    try
      let e ← withReducible <| whnf e
      let ⟨.succ u, α, e⟩ ← inferTypeQ e | failure
      let sα ← synthInstanceQ (q(CommSemiring $α) : Q(Type u))
      let c ← mkCache sα
      match ← isAtomOrDerivable sα c e rctx with
      | some none => pure .true
      | _ => pure .false
    catch _ => pure .false

-- /-- Run a computation in the `AtomM` monad and return the atoms. -/
-- def Mathlib.Tactic.AtomM.run' (red : TransparencyMode) (m : AtomM α)
--     (evalAtom : Expr → MetaM Simp.Result := fun e ↦ pure { expr := e }) :
--     MetaM (α × AtomM.State)  :=
--   (m { red, evalAtom }).run {}

open Lean Meta Elab Tactic Term PrettyPrinter in
elab "elinarith" : tactic => do
  let mvarId ← getMainTarget
  -- logInfo mvarId
  -- (←getMainGoal).withContext do
  --   withLocalDeclDQ (← mkFreshUserName `x) q(ℤ) fun x => do
  --   let e : Q(Prop) := q($x ≤ $x+2)
  -- let e : Q(Prop) := mvarId --q($x ≤ $x+2)
  -- get all atoms using ring
  let (_, a) ← Mathlib.Tactic.AtomM.run .default do
    StateT.run (σ := Array Expr) do
        mvarId.forEach' fun e' =>
          do
            let b ← is_atom e'
            if b then
              set ((← get).push e')
            pure ¬ b
      #[]
  -- logInfo (← getMainGoal)
  let mut goals := [(← getMainGoal)]
  for e in a do
    let tac ←
      `(tactic| cases h : $(←delab e):term <;>
                simp only [h, Enat.ofN_eq_ofNat, Enat.top_add, Enat.add_top,
                  Enat.ofNatAtLeastTwoMulInfty, Enat.inftyMulofNatAtLeastTwo,
                  Nat.cast_add, Nat.cast_one, Nat.cast_mul, Nat.cast_ofNat
                ] at * <;>
                norm_cast at * <;>
                try linarith)
    -- logInfo e
    let mut newgs := []
    for g in goals do
      let a ← Elab.runTactic g tac
      newgs := newgs ++ a.1
    goals := newgs
  setGoals goals

def tt : Enat -> Enat := sorry
example (x : Enat) (h : 1 ≤ tt x) : 2 ≤ 1 + tt x :=
by
  elinarith

example (x : Enat) (h : 0 < x) : 2 ≤ 1 + x :=
by
  elinarith

example (x : Enat) (h : 0 < x) : 3 ≤ 1 + 2 * x :=
by
  elinarith

example (x : Enat) (h : 0 < x) : 3 ≤ 1 + 2 * x :=
by
  cases x
  simp at *
  norm_cast at *
  linarith
  simp?

example (y  x : Enat) (h : 0 < y) (g : y ≤ 3) : y < 2 * y :=
by
  elinarith
example (x y : Enat) (h : 0 < x) (g : 3 ≤ y) : 3 ≤ 1 + 2 * x + y :=
by
  elinarith

-- TODO spell check all comments / docstrings, linarith thaat
-- TODO go to definition in doc comments eg `Mathlib.Tactic.casesMatching`

#check Mathlib.Tactic.casesMatching

/-

many tactics work like:

some defined language of functions normally coming from a TC
reified into a language
do something

issues with this is sensitive to language
good to have some boilerplate so we
unfolds unrecognised functions
e.g. group tactic should be ok with `[g, h]` because the definition of `[g,h]` is ghginv hinv.
-/


/- split tactic -/

def f (x y z : Nat) : Nat :=
  match x, y, z with
  | 5, _, _ => y
  | _, 5, _ => y
  | _, _, 5 => y
  | _, _, _ => 1

example : x ≠ 5 → y ≠ 5 → z ≠ 5 → z = w → f x y w = 1 := by
  intros
  simp [f]
  split
  . contradiction
  . contradiction
  . contradiction
  . rfl

def g (xs ys : List Nat) : Nat :=
  match xs, ys with
  | [a, b], _ => a+b+1
  | _, [b, c] => b+1
  | _, _      => 1

example (xs ys : List Nat) (h : g xs ys = 0) : False := by
  unfold g at h; split at h <;> simp_arith at h


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.cast
import Mathlib.data.rat.meta_defs
import Mathlib.PostPort

universes u_1 u

namespace Mathlib

/-!
# `norm_num`

Evaluating arithmetic expressions including `*`, `+`, `-`, `^`, `≤`.
-/

namespace tactic

/-- Reflexivity conversion: given `e` returns `(e, ⊢ e = e)` -/
/-- Transitivity conversion: given two conversions (which take an
expression `e` and returns `(e', ⊢ e = e')`), produces another
conversion that combines them with transitivity, treating failures
as reflexivity conversions. -/
namespace instance_cache

/-- Faster version of `mk_app ``bit0 [e]`. -/
/-- Faster version of `mk_app ``bit1 [e]`. -/
end instance_cache

end tactic

namespace norm_num

theorem subst_into_add {α : Type u_1} [Add α] (l : α) (r : α) (tl : α) (tr : α) (t : α)
    (prl : l = tl) (prr : r = tr) (prt : tl + tr = t) : l + r = t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (l + r = t)) prl))
    (eq.mpr (id (Eq._oldrec (Eq.refl (tl + r = t)) prr))
      (eq.mpr (id (Eq._oldrec (Eq.refl (tl + tr = t)) prt)) (Eq.refl t)))

theorem subst_into_mul {α : Type u_1} [Mul α] (l : α) (r : α) (tl : α) (tr : α) (t : α)
    (prl : l = tl) (prr : r = tr) (prt : tl * tr = t) : l * r = t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (l * r = t)) prl))
    (eq.mpr (id (Eq._oldrec (Eq.refl (tl * r = t)) prr))
      (eq.mpr (id (Eq._oldrec (Eq.refl (tl * tr = t)) prt)) (Eq.refl t)))

theorem subst_into_neg {α : Type u_1} [Neg α] (a : α) (ta : α) (t : α) (pra : a = ta)
    (prt : -ta = t) : -a = t :=
  sorry

/-- The result type of `match_numeral`, either `0`, `1`, or a top level
decomposition of `bit0 e` or `bit1 e`. The `other` case means it is not a numeral. -/
/-- Unfold the top level constructor of the numeral expression. -/
theorem zero_succ {α : Type u_1} [semiring α] : 0 + 1 = 1 := zero_add 1

theorem one_succ {α : Type u_1} [semiring α] : 1 + 1 = bit0 1 := rfl

theorem bit0_succ {α : Type u_1} [semiring α] (a : α) : bit0 a + 1 = bit1 a := rfl

theorem bit1_succ {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) :
    bit1 a + 1 = bit0 b :=
  sorry

/-- Given `a`, `b` natural numerals, proves `⊢ a + 1 = b`, assuming that this is provable.
(It may prove garbage instead of failing if `a + 1 = b` is false.) -/
theorem zero_adc {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) : 0 + a + 1 = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 + a + 1 = b)) (zero_add a))) h

theorem adc_zero {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) : a + 0 + 1 = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a + 0 + 1 = b)) (add_zero a))) h

theorem one_add {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) : 1 + a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 + a = b)) (add_comm 1 a))) h

theorem add_bit0_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b = c) :
    bit0 a + bit0 b = bit0 c :=
  sorry

theorem add_bit0_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b = c) :
    bit0 a + bit1 b = bit1 c :=
  sorry

theorem add_bit1_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b = c) :
    bit1 a + bit0 b = bit1 c :=
  sorry

theorem add_bit1_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b + 1 = c) :
    bit1 a + bit1 b = bit0 c :=
  sorry

theorem adc_one_one {α : Type u_1} [semiring α] : 1 + 1 + 1 = bit1 1 := rfl

theorem adc_bit0_one {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) :
    bit0 a + 1 + 1 = bit0 b :=
  sorry

theorem adc_one_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) :
    1 + bit0 a + 1 = bit0 b :=
  sorry

theorem adc_bit1_one {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) :
    bit1 a + 1 + 1 = bit1 b :=
  sorry

theorem adc_one_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (h : a + 1 = b) :
    1 + bit1 a + 1 = bit1 b :=
  sorry

theorem adc_bit0_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b = c) :
    bit0 a + bit0 b + 1 = bit1 c :=
  sorry

theorem adc_bit1_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b + 1 = c) :
    bit1 a + bit0 b + 1 = bit0 c :=
  sorry

theorem adc_bit0_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b + 1 = c) :
    bit0 a + bit1 b + 1 = bit0 c :=
  sorry

theorem adc_bit1_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a + b + 1 = c) :
    bit1 a + bit1 b + 1 = bit1 c :=
  sorry

/-- Given `a`,`b`,`r` natural numerals, proves `⊢ a + b = r`. -/
/-- Given `a`,`b`,`r` natural numerals, proves `⊢ a + b + 1 = r`. -/
/-- Given `a`,`b` natural numerals, returns `(r, ⊢ a + b = r)`. -/
theorem bit0_mul {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a * b = c) :
    bit0 a * b = bit0 c :=
  sorry

theorem mul_bit0' {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a * b = c) :
    a * bit0 b = bit0 c :=
  sorry

theorem mul_bit0_bit0 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (h : a * b = c) :
    bit0 a * bit0 b = bit0 (bit0 c) :=
  bit0_mul a (bit0 b) (bit0 c) (mul_bit0' a b c h)

theorem mul_bit1_bit1 {α : Type u_1} [semiring α] (a : α) (b : α) (c : α) (d : α) (e : α)
    (hc : a * b = c) (hd : a + b = d) (he : bit0 c + d = e) : bit1 a * bit1 b = bit1 e :=
  sorry

/-- Given `a`,`b` natural numerals, returns `(r, ⊢ a * b = r)`. -/
/-- Given `a` a positive natural numeral, returns `⊢ 0 < a`. -/
/-- Given `a` a rational numeral, returns `⊢ 0 < a`. -/
/-- `match_neg (- e) = some e`, otherwise `none` -/
/-- `match_sign (- e) = inl e`, `match_sign 0 = inr ff`, otherwise `inr tt` -/
theorem ne_zero_of_pos {α : Type u_1} [ordered_add_comm_group α] (a : α) : 0 < a → a ≠ 0 := ne_of_gt

theorem ne_zero_neg {α : Type u_1} [add_group α] (a : α) : a ≠ 0 → -a ≠ 0 := mt (iff.mp neg_eq_zero)

/-- Given `a` a rational numeral, returns `⊢ a ≠ 0`. -/
theorem clear_denom_div {α : Type u_1} [division_ring α] (a : α) (b : α) (b' : α) (c : α) (d : α)
    (h₀ : b ≠ 0) (h₁ : b * b' = d) (h₂ : a * b' = c) : a / b * d = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b * d = c)) (Eq.symm h₁)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * (b * b') = c)) (Eq.symm (mul_assoc (a / b) b b'))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a / b * b * b' = c)) (div_mul_cancel a h₀))) h₂))

/-- Given `a` nonnegative rational and `d` a natural number, returns `(b, ⊢ a * d = b)`.
(`d` should be a multiple of the denominator of `a`, so that `b` is a natural number.) -/
theorem nonneg_pos {α : Type u_1} [ordered_cancel_add_comm_monoid α] (a : α) : 0 < a → 0 ≤ a :=
  le_of_lt

theorem lt_one_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (h : 1 ≤ a) : 1 < bit0 a :=
  lt_of_lt_of_le one_lt_two (iff.mpr bit0_le_bit0 h)

theorem lt_one_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (h : 0 < a) : 1 < bit1 a :=
  iff.mpr one_lt_bit1 h

theorem lt_bit0_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) :
    a < b → bit0 a < bit0 b :=
  iff.mpr bit0_lt_bit0

theorem lt_bit0_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a ≤ b) :
    bit0 a < bit1 b :=
  lt_of_le_of_lt (iff.mpr bit0_le_bit0 h) (lt_add_one (bit0 b))

theorem lt_bit1_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a + 1 ≤ b) :
    bit1 a < bit0 b :=
  sorry

theorem lt_bit1_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) :
    a < b → bit1 a < bit1 b :=
  iff.mpr bit1_lt_bit1

theorem le_one_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (h : 1 ≤ a) : 1 ≤ bit0 a :=
  le_of_lt (lt_one_bit0 a h)

-- deliberately strong hypothesis because bit1 0 is not a numeral

theorem le_one_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (h : 0 < a) : 1 ≤ bit1 a :=
  le_of_lt (lt_one_bit1 a h)

theorem le_bit0_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) :
    a ≤ b → bit0 a ≤ bit0 b :=
  iff.mpr bit0_le_bit0

theorem le_bit0_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a ≤ b) :
    bit0 a ≤ bit1 b :=
  le_of_lt (lt_bit0_bit1 a b h)

theorem le_bit1_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a + 1 ≤ b) :
    bit1 a ≤ bit0 b :=
  le_of_lt (lt_bit1_bit0 a b h)

theorem le_bit1_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) :
    a ≤ b → bit1 a ≤ bit1 b :=
  iff.mpr bit1_le_bit1

theorem sle_one_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) : 1 ≤ a → 1 + 1 ≤ bit0 a :=
  iff.mpr bit0_le_bit0

theorem sle_one_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) : 1 ≤ a → 1 + 1 ≤ bit1 a :=
  le_bit0_bit1 1 a

theorem sle_bit0_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) :
    a + 1 ≤ b → bit0 a + 1 ≤ bit0 b :=
  le_bit1_bit0 a b

theorem sle_bit0_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a ≤ b) :
    bit0 a + 1 ≤ bit1 b :=
  iff.mpr bit1_le_bit1 h

theorem sle_bit1_bit0 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a + 1 ≤ b) :
    bit1 a + 1 ≤ bit0 b :=
  Eq.symm (bit1_succ a (a + 1) rfl) ▸ iff.mpr bit0_le_bit0 h

theorem sle_bit1_bit1 {α : Type u_1} [linear_ordered_semiring α] (a : α) (b : α) (h : a + 1 ≤ b) :
    bit1 a + 1 ≤ bit1 b :=
  Eq.symm (bit1_succ a (a + 1) rfl) ▸ le_bit0_bit1 (a + 1) b h

/-- Given `a` a rational numeral, returns `⊢ 0 ≤ a`. -/
/-- Given `a` a rational numeral, returns `⊢ 1 ≤ a`. -/
/-- Given `a`,`b` natural numerals, proves `⊢ a ≤ b`. -/
/-- Given `a`,`b` natural numerals, proves `⊢ a + 1 ≤ b`. -/
/-- Given `a`,`b` natural numerals, proves `⊢ a < b`. -/
theorem clear_denom_lt {α : Type u_1} [linear_ordered_semiring α] (a : α) (a' : α) (b : α) (b' : α)
    (d : α) (h₀ : 0 < d) (ha : a * d = a') (hb : b * d = b') (h : a' < b') : a < b :=
  lt_of_mul_lt_mul_right
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * d < b * d)) ha))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a' < b * d)) hb)) h))
    (le_of_lt h₀)

/-- Given `a`,`b` nonnegative rational numerals, proves `⊢ a < b`. -/
theorem lt_neg_pos {α : Type u_1} [ordered_add_comm_group α] (a : α) (b : α) (ha : 0 < a)
    (hb : 0 < b) : -a < b :=
  lt_trans (neg_neg_of_pos ha) hb

/-- Given `a`,`b` rational numerals, proves `⊢ a < b`. -/
theorem clear_denom_le {α : Type u_1} [linear_ordered_semiring α] (a : α) (a' : α) (b : α) (b' : α)
    (d : α) (h₀ : 0 < d) (ha : a * d = a') (hb : b * d = b') (h : a' ≤ b') : a ≤ b :=
  le_of_mul_le_mul_right
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * d ≤ b * d)) ha))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a' ≤ b * d)) hb)) h))
    h₀

/-- Given `a`,`b` nonnegative rational numerals, proves `⊢ a ≤ b`. -/
theorem le_neg_pos {α : Type u_1} [ordered_add_comm_group α] (a : α) (b : α) (ha : 0 ≤ a)
    (hb : 0 ≤ b) : -a ≤ b :=
  le_trans (neg_nonpos_of_nonneg ha) hb

/-- Given `a`,`b` rational numerals, proves `⊢ a ≤ b`. -/
/-- Given `a`,`b` rational numerals, proves `⊢ a ≠ b`. This version tries to prove
`⊢ a < b` or `⊢ b < a`, and so is not appropriate for types without an order relation. -/
theorem nat_cast_zero {α : Type u_1} [semiring α] : ↑0 = 0 := nat.cast_zero

theorem nat_cast_one {α : Type u_1} [semiring α] : ↑1 = 1 := nat.cast_one

theorem nat_cast_bit0 {α : Type u_1} [semiring α] (a : ℕ) (a' : α) (h : ↑a = a') :
    ↑(bit0 a) = bit0 a' :=
  h ▸ nat.cast_bit0 a

theorem nat_cast_bit1 {α : Type u_1} [semiring α] (a : ℕ) (a' : α) (h : ↑a = a') :
    ↑(bit1 a) = bit1 a' :=
  h ▸ nat.cast_bit1 a

theorem int_cast_zero {α : Type u_1} [ring α] : ↑0 = 0 := int.cast_zero

theorem int_cast_one {α : Type u_1} [ring α] : ↑1 = 1 := int.cast_one

theorem int_cast_bit0 {α : Type u_1} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') :
    ↑(bit0 a) = bit0 a' :=
  h ▸ int.cast_bit0 a

theorem int_cast_bit1 {α : Type u_1} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') :
    ↑(bit1 a) = bit1 a' :=
  h ▸ int.cast_bit1 a

theorem rat_cast_bit0 {α : Type u_1} [division_ring α] [char_zero α] (a : ℚ) (a' : α)
    (h : ↑a = a') : ↑(bit0 a) = bit0 a' :=
  h ▸ rat.cast_bit0 a

theorem rat_cast_bit1 {α : Type u_1} [division_ring α] [char_zero α] (a : ℚ) (a' : α)
    (h : ↑a = a') : ↑(bit1 a) = bit1 a' :=
  h ▸ rat.cast_bit1 a

/-- Given `a' : α` a natural numeral, returns `(a : ℕ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
/-- Given `a' : α` a natural numeral, returns `(a : ℤ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
/-- Given `a' : α` a natural numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
theorem rat_cast_div {α : Type u_1} [division_ring α] [char_zero α] (a : ℚ) (b : ℚ) (a' : α)
    (b' : α) (ha : ↑a = a') (hb : ↑b = b') : ↑(a / b) = a' / b' :=
  ha ▸ hb ▸ rat.cast_div a b

/-- Given `a' : α` a nonnegative rational numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
theorem int_cast_neg {α : Type u_1} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') : ↑(-a) = -a' :=
  h ▸ int.cast_neg a

theorem rat_cast_neg {α : Type u_1} [division_ring α] (a : ℚ) (a' : α) (h : ↑a = a') :
    ↑(-a) = -a' :=
  h ▸ rat.cast_neg a

/-- Given `a' : α` an integer numeral, returns `(a : ℤ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
/-- Given `a' : α` a rational numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
theorem nat_cast_ne {α : Type u_1} [semiring α] [char_zero α] (a : ℕ) (b : ℕ) (a' : α) (b' : α)
    (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
  ha ▸ hb ▸ mt (iff.mp nat.cast_inj) h

theorem int_cast_ne {α : Type u_1} [ring α] [char_zero α] (a : ℤ) (b : ℤ) (a' : α) (b' : α)
    (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
  ha ▸ hb ▸ mt (iff.mp int.cast_inj) h

theorem rat_cast_ne {α : Type u_1} [division_ring α] [char_zero α] (a : ℚ) (b : ℚ) (a' : α) (b' : α)
    (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
  ha ▸ hb ▸ mt (iff.mp rat.cast_inj) h

/-- Given `a`,`b` rational numerals, proves `⊢ a ≠ b`. Currently it tries two methods:

  * Prove `⊢ a < b` or `⊢ b < a`, if the base type has an order
  * Embed `↑(a':ℚ) = a` and `↑(b':ℚ) = b`, and then prove `a' ≠ b'`.
    This requires that the base type be `char_zero`, and also that it be a `division_ring`
    so that the coercion from `ℚ` is well defined.

We may also add coercions to `ℤ` and `ℕ` as well in order to support `char_zero`
rings and semirings. -/
/-- Given `a` a rational numeral, returns `⊢ a ≠ 0`. -/
/-- Given `a` nonnegative rational and `d` a natural number, returns `(b, ⊢ a * d = b)`.
(`d` should be a multiple of the denominator of `a`, so that `b` is a natural number.) -/
theorem clear_denom_add {α : Type u_1} [division_ring α] (a : α) (a' : α) (b : α) (b' : α) (c : α)
    (c' : α) (d : α) (h₀ : d ≠ 0) (ha : a * d = a') (hb : b * d = b') (hc : c * d = c')
    (h : a' + b' = c') : a + b = c :=
  sorry

/-- Given `a`,`b`,`c` nonnegative rational numerals, returns `⊢ a + b = c`. -/
theorem add_pos_neg_pos {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : c + b = a) :
    a + -b = c :=
  sorry

theorem add_pos_neg_neg {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : c + a = b) :
    a + -b = -c :=
  sorry

theorem add_neg_pos_pos {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : a + c = b) :
    -a + b = c :=
  sorry

theorem add_neg_pos_neg {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : b + c = a) :
    -a + b = -c :=
  sorry

theorem add_neg_neg {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : b + a = c) :
    -a + -b = -c :=
  sorry

/-- Given `a`,`b`,`c` rational numerals, returns `⊢ a + b = c`. -/
/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a + b = c)`. -/
theorem clear_denom_simple_nat {α : Type u_1} [division_ring α] (a : α) : 1 ≠ 0 ∧ a * 1 = a :=
  { left := one_ne_zero, right := mul_one a }

theorem clear_denom_simple_div {α : Type u_1} [division_ring α] (a : α) (b : α) (h : b ≠ 0) :
    b ≠ 0 ∧ a / b * b = a :=
  { left := h, right := div_mul_cancel a h }

/-- Given `a` a nonnegative rational numeral, returns `(b, c, ⊢ a * b = c)`
where `b` and `c` are natural numerals. (`b` will be the denominator of `a`.) -/
theorem clear_denom_mul {α : Type u_1} [field α] (a : α) (a' : α) (b : α) (b' : α) (c : α) (c' : α)
    (d₁ : α) (d₂ : α) (d : α) (ha : d₁ ≠ 0 ∧ a * d₁ = a') (hb : d₂ ≠ 0 ∧ b * d₂ = b')
    (hc : c * d = c') (hd : d₁ * d₂ = d) (h : a' * b' = c') : a * b = c :=
  sorry

/-- Given `a`,`b` nonnegative rational numerals, returns `(c, ⊢ a * b = c)`. -/
theorem mul_neg_pos {α : Type u_1} [ring α] (a : α) (b : α) (c : α) (h : a * b = c) : -a * b = -c :=
  sorry

theorem mul_pos_neg {α : Type u_1} [ring α] (a : α) (b : α) (c : α) (h : a * b = c) : a * -b = -c :=
  sorry

theorem mul_neg_neg {α : Type u_1} [ring α] (a : α) (b : α) (c : α) (h : a * b = c) : -a * -b = c :=
  sorry

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a * b = c)`. -/
theorem inv_neg {α : Type u_1} [division_ring α] (a : α) (b : α) (h : a⁻¹ = b) : -a⁻¹ = -b := sorry

theorem inv_one {α : Type u_1} [division_ring α] : 1⁻¹ = 1 := inv_one

theorem inv_one_div {α : Type u_1} [division_ring α] (a : α) : 1 / a⁻¹ = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 / a⁻¹ = a)) (one_div a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹⁻¹ = a)) (inv_inv' a))) (Eq.refl a))

theorem inv_div_one {α : Type u_1} [division_ring α] (a : α) : a⁻¹ = 1 / a := inv_eq_one_div a

theorem inv_div {α : Type u_1} [division_ring α] (a : α) (b : α) : a / b⁻¹ = b / a := sorry

/-- Given `a` a rational numeral, returns `(b, ⊢ a⁻¹ = b)`. -/
theorem div_eq {α : Type u_1} [division_ring α] (a : α) (b : α) (b' : α) (c : α) (hb : b⁻¹ = b')
    (h : a * b' = c) : a / b = c :=
  eq.mp (Eq._oldrec (Eq.refl (a * (b⁻¹) = c)) (Eq.symm (div_eq_mul_inv a b)))
    (eq.mp (Eq._oldrec (Eq.refl (a * b' = c)) (Eq.symm hb)) h)

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a / b = c)`. -/
/-- Given `a` a rational numeral, returns `(b, ⊢ -a = b)`. -/
theorem sub_pos {α : Type u_1} [add_group α] (a : α) (b : α) (b' : α) (c : α) (hb : -b = b')
    (h : a + b' = c) : a - b = c :=
  eq.mp (Eq._oldrec (Eq.refl (a + -b = c)) (Eq.symm (sub_eq_add_neg a b)))
    (eq.mp (Eq._oldrec (Eq.refl (a + b' = c)) (Eq.symm hb)) h)

theorem sub_neg {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : a + b = c) : a - -b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - -b = c)) (sub_neg_eq_add a b))) h

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a - b = c)`. -/
theorem sub_nat_pos (a : ℕ) (b : ℕ) (c : ℕ) (h : b + c = a) : a - b = c :=
  h ▸ nat.add_sub_cancel_left b c

theorem sub_nat_neg (a : ℕ) (b : ℕ) (c : ℕ) (h : a + c = b) : a - b = 0 :=
  nat.sub_eq_zero_of_le (h ▸ nat.le_add_right a c)

/-- Given `a : nat`,`b : nat` natural numerals, returns `(c, ⊢ a - b = c)`. -/
/-- Evaluates the basic field operations `+`,`neg`,`-`,`*`,`inv`,`/` on numerals.
Also handles nat subtraction. Does not do recursive simplification; that is,
`1 + 1 + 1` will not simplify but `2 + 1` will. This is handled by the top level
`simp` call in `norm_num.derive`. -/
theorem pow_bit0 {α : Type u} [monoid α] (a : α) (c' : α) (c : α) (b : ℕ) (h : a ^ b = c')
    (h₂ : c' * c' = c) : a ^ bit0 b = c :=
  sorry

theorem pow_bit1 {α : Type u} [monoid α] (a : α) (c₁ : α) (c₂ : α) (c : α) (b : ℕ) (h : a ^ b = c₁)
    (h₂ : c₁ * c₁ = c₂) (h₃ : c₂ * a = c) : a ^ bit1 b = c :=
  sorry

/-- Given `a` a rational numeral and `b : nat`, returns `(c, ⊢ a ^ b = c)`. -/
/-- Evaluates expressions of the form `a ^ b`, `monoid.pow a b` or `nat.pow a b`. -/
/-- Given `⊢ p`, returns `(true, ⊢ p = true)`. -/
/-- Given `⊢ ¬ p`, returns `(false, ⊢ p = false)`. -/
theorem not_refl_false_intro {α : Sort u_1} (a : α) : a ≠ a = False :=
  eq_false_intro (not_not_intro rfl)

/-- Evaluates the inequality operations `=`,`<`,`>`,`≤`,`≥`,`≠` on numerals. -/
theorem nat_succ_eq (a : ℕ) (b : ℕ) (c : ℕ) (h₁ : a = b) (h₂ : b + 1 = c) : Nat.succ a = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (Nat.succ a = c)) h₁)) h₂

/-- Evaluates the expression `nat.succ ... (nat.succ n)` where `n` is a natural numeral.
(We could also just handle `nat.succ n` here and rely on `simp` to work bottom up, but we figure
that towers of successors coming from e.g. `induction` are a common case.) -/
theorem nat_div (a : ℕ) (b : ℕ) (q : ℕ) (r : ℕ) (m : ℕ) (hm : q * b = m) (h : r + m = a)
    (h₂ : r < b) : a / b = q :=
  sorry

theorem int_div (a : ℤ) (b : ℤ) (q : ℤ) (r : ℤ) (m : ℤ) (hm : q * b = m) (h : r + m = a)
    (h₁ : 0 ≤ r) (h₂ : r < b) : a / b = q :=
  sorry

theorem nat_mod (a : ℕ) (b : ℕ) (q : ℕ) (r : ℕ) (m : ℕ) (hm : q * b = m) (h : r + m = a)
    (h₂ : r < b) : a % b = r :=
  sorry

theorem int_mod (a : ℤ) (b : ℤ) (q : ℤ) (r : ℤ) (m : ℤ) (hm : q * b = m) (h : r + m = a)
    (h₁ : 0 ≤ r) (h₂ : r < b) : a % b = r :=
  sorry

theorem int_div_neg (a : ℤ) (b : ℤ) (c' : ℤ) (c : ℤ) (h : a / b = c') (h₂ : -c' = c) : a / -b = c :=
  h₂ ▸ h ▸ int.div_neg a b

theorem int_mod_neg (a : ℤ) (b : ℤ) (c : ℤ) (h : a % b = c) : a % -b = c :=
  Eq.trans (int.mod_neg a b) h

/-- Given `a`,`b` numerals in `nat` or `int`,
  * `prove_div_mod ic a b ff` returns `(c, ⊢ a / b = c)`
  * `prove_div_mod ic a b tt` returns `(c, ⊢ a % b = c)`
-/
theorem dvd_eq_nat (a : ℕ) (b : ℕ) (c : ℕ) (p : Prop) (h₁ : b % a = c) (h₂ : c = 0 = p) :
    a ∣ b = p :=
  sorry

theorem dvd_eq_int (a : ℤ) (b : ℤ) (c : ℤ) (p : Prop) (h₁ : b % a = c) (h₂ : c = 0 = p) :
    a ∣ b = p :=
  sorry

/-- Evaluates some extra numeric operations on `nat` and `int`, specifically
`nat.succ`, `/` and `%`, and `∣` (divisibility). -/
/-- This version of `derive` does not fail when the input is already a numeral -/
/-- An attribute for adding additional extensions to `norm_num`. To use this attribute, put
`@[norm_num]` on a tactic of type `expr → tactic (expr × expr)`; the tactic will be called on
subterms by `norm_num`, and it is responsible for identifying that the expression is a numerical
function applied to numerals, for example `nat.fib 17`, and should return the reduced numerical
expression (which must be in `norm_num`-normal form: a natural or rational numeral, i.e. `37`,
`12 / 7` or `-(2 / 3)`, although this can be an expression in any type), and the proof that the
original expression is equal to the rewritten expression.

Failure is used to indicate that this tactic does not apply to the term. For performance reasons,
it is best to detect non-applicability as soon as possible so that the next tactic can have a go,
so generally it will start with a pattern match and then checking that the arguments to the term
are numerals or of the appropriate form, followed by proof construction, which should not fail.

Propositions are treated like any other term. The normal form for propositions is `true` or
`false`, so it should produce a proof of the form `p = true` or `p = false`. `eq_true_intro` can be
used to help here.
-/
/-- Look up the `norm_num` extensions in the cache and return a tactic extending `derive.step` with
additional reduction procedures. -/
/-- Simplify an expression bottom-up using `step` to simplify the subexpressions. -/
/-- Simplify an expression bottom-up using the default `norm_num` set to simplify the
subexpressions. -/
end norm_num

/-- Basic version of `norm_num` that does not call `simp`. It uses the provided `step` tactic
to simplify the expression; use `get_step` to get the default `norm_num` set and `derive.step` for
the basic builtin set of simplifications. -/
/-- Normalize numerical expressions. It uses the provided `step` tactic to simplify the expression;
use `get_step` to get the default `norm_num` set and `derive.step` for the basic builtin set of
simplifications. -/
namespace tactic.interactive

/-- Basic version of `norm_num` that does not call `simp`. -/
/-- Normalize numerical expressions. Supports the operations
`+` `-` `*` `/` `^` and `%` over numerical types such as
`ℕ`, `ℤ`, `ℚ`, `ℝ`, `ℂ` and some general algebraic types,
and can prove goals of the form `A = B`, `A ≠ B`, `A < B` and `A ≤ B`,
where `A` and `B` are numerical expressions.
It also has a relatively simple primality prover. -/
/-- Normalizes a numerical expression and tries to close the goal with the result. -/
/--
Normalises numerical expressions. It supports the operations `+` `-` `*` `/` `^` and `%` over
end Mathlib


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

! This file was ported from Lean 3 source module control.traversable.equiv
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Traversable.Lemmas
import Mathbin.Logic.Equiv.Defs

/-!
# Transferring `traversable` instances along isomorphisms

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

This file allows to transfer `traversable` instances along isomorphisms.

## Main declarations

* `equiv.map`: Turns functorially a function `α → β` into a function `t' α → t' β` using the functor
  `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.functor`: `equiv.map` as a functor.
* `equiv.traverse`: Turns traversably a function `α → m β` into a function `t' α → m (t' β)` using
  the traversable functor `t` and the equivalence `Π α, t α ≃ t' α`.
* `equiv.traversable`: `equiv.traverse` as a traversable functor.
* `equiv.is_lawful_traversable`: `equiv.traverse` as a lawful traversable functor.
-/

universe u

namespace Equiv

section Functor

parameter {t t' : Type u → Type u}

parameter (eqv : ∀ α, t α ≃ t' α)

variable [Functor t]

open Functor

#print Equiv.map /-
/-- Given a functor `t`, a function `t' : Type u → Type u`, and
equivalences `t α ≃ t' α` for all `α`, then every function `α → β` can
be mapped to a function `t' α → t' β` functorially (see
`equiv.functor`). -/
protected def map {α β : Type u} (f : α → β) (x : t' α) : t' β :=
  eqv β <| map f ((eqv α).symm x)
#align equiv.map Equiv.map
-/

#print Equiv.functor /-
/-- The function `equiv.map` transfers the functoriality of `t` to
`t'` using the equivalences `eqv`.  -/
protected def functor : Functor t' where map := @Equiv.map _
#align equiv.functor Equiv.functor
-/

variable [LawfulFunctor t]

#print Equiv.id_map /-
protected theorem id_map {α : Type u} (x : t' α) : Equiv.map id x = x := by simp [Equiv.map, id_map]
#align equiv.id_map Equiv.id_map
-/

#print Equiv.comp_map /-
protected theorem comp_map {α β γ : Type u} (g : α → β) (h : β → γ) (x : t' α) :
    Equiv.map (h ∘ g) x = Equiv.map h (Equiv.map g x) := by simp [Equiv.map] <;> apply comp_map
#align equiv.comp_map Equiv.comp_map
-/

#print Equiv.lawfulFunctor /-
protected theorem lawfulFunctor : @LawfulFunctor _ Equiv.functor :=
  { id_map := @Equiv.id_map _ _
    comp_map := @Equiv.comp_map _ _ }
#align equiv.is_lawful_functor Equiv.lawfulFunctor
-/

#print Equiv.lawfulFunctor' /-
protected theorem lawfulFunctor' [F : Functor t']
    (h₀ : ∀ {α β} (f : α → β), Functor.map f = Equiv.map f)
    (h₁ : ∀ {α β} (f : β), Functor.mapConst f = (Equiv.map ∘ Function.const α) f) :
    LawfulFunctor t' :=
  by
  have : F = Equiv.functor := by
    cases F
    dsimp [Equiv.functor]
    congr <;> ext <;> [rw [← h₀], rw [← h₁]]
  subst this
  exact Equiv.lawfulFunctor
#align equiv.is_lawful_functor' Equiv.lawfulFunctor'
-/

end Functor

section Traversable

parameter {t t' : Type u → Type u}

parameter (eqv : ∀ α, t α ≃ t' α)

variable [Traversable t]

variable {m : Type u → Type u} [Applicative m]

variable {α β : Type u}

#print Equiv.traverse /-
/-- Like `equiv.map`, a function `t' : Type u → Type u` can be given
the structure of a traversable functor using a traversable functor
`t'` and equivalences `t α ≃ t' α` for all α.  See `equiv.traversable`. -/
protected def traverse (f : α → m β) (x : t' α) : m (t' β) :=
  eqv β <$> traverse f ((eqv α).symm x)
#align equiv.traverse Equiv.traverse
-/

#print Equiv.traversable /-
/-- The function `equiv.traverse` transfers a traversable functor
instance across the equivalences `eqv`. -/
protected def traversable : Traversable t'
    where
  toFunctor := Equiv.functor eqv
  traverse := @Equiv.traverse _
#align equiv.traversable Equiv.traversable
-/

end Traversable

section Equiv

parameter {t t' : Type u → Type u}

parameter (eqv : ∀ α, t α ≃ t' α)

variable [Traversable t] [IsLawfulTraversable t]

variable {F G : Type u → Type u} [Applicative F] [Applicative G]

variable [LawfulApplicative F] [LawfulApplicative G]

variable (η : ApplicativeTransformation F G)

variable {α β γ : Type u}

open IsLawfulTraversable Functor

/- warning: equiv.id_traverse -> Equiv.id_traverse is a dubious translation:
lean 3 declaration is
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {α : Type.{u1}} (x : t' α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (t' α)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {α : Type.{u1}} (x : t' α), Eq.{succ u1} (Id.{u1} (t' α)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align equiv.id_traverse Equiv.id_traverseₓ'. -/
protected theorem id_traverse (x : t' α) : Equiv.traverse eqv id.mk x = x := by
  simp! [Equiv.traverse, idBind, id_traverse, Functor.map, functor_norm]
#align equiv.id_traverse Equiv.id_traverse

/- warning: equiv.traverse_eq_map_id -> Equiv.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : t' α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (t' β)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (t' β) (Equiv.map.{u1} (fun (α : Type.{u1}) => t α) t' eqv (Traversable.toFunctor.{u1} (fun (α : Type.{u1}) => t α) _inst_1) α β f x))
but is expected to have type
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : t' α), Eq.{succ u1} (Id.{u1} (t' β)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (t' β) (Equiv.map.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv (Traversable.toFunctor.{u1} (fun (α : Type.{u1}) => t α) _inst_1) α β f x))
Case conversion may be inaccurate. Consider using '#align equiv.traverse_eq_map_id Equiv.traverse_eq_map_idₓ'. -/
protected theorem traverse_eq_map_id (f : α → β) (x : t' α) :
    Equiv.traverse eqv (id.mk ∘ f) x = id.mk (Equiv.map eqv f x) := by
  simp [Equiv.traverse, traverse_eq_map_id, functor_norm] <;> rfl
#align equiv.traverse_eq_map_id Equiv.traverse_eq_map_id

/- warning: equiv.comp_traverse -> Equiv.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_3 : Applicative.{u1, u1} F] [_inst_4 : Applicative.{u1, u1} G] [_inst_5 : LawfulApplicative.{u1, u1} F _inst_3] [_inst_6 : LawfulApplicative.{u1, u1} G _inst_4] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : t' α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (t' γ)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F _inst_4 _inst_3) α γ (Function.comp.{succ u1, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Function.comp.{succ u1, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_4) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (t' γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_4) (t' β) (F (t' γ)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) t' eqv _inst_1 F _inst_3 β γ f) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) t' eqv _inst_1 G _inst_4 α β g x)))
but is expected to have type
  forall {t : Type.{u1} -> Type.{u1}} {t' : Type.{u1} -> Type.{u1}} (eqv : forall (α : Type.{u1}), Equiv.{succ u1, succ u1} (t α) (t' α)) [_inst_1 : Traversable.{u1} t] [_inst_2 : IsLawfulTraversable.{u1} t _inst_1] {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_3 : Applicative.{u1, u1} F] [_inst_4 : Applicative.{u1, u1} G] [_inst_5 : LawfulApplicative.{u1, u1} F _inst_3] [_inst_6 : LawfulApplicative.{u1, u1} G _inst_4] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : t' α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} G F (t' γ)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 (Functor.Comp.{u1, u1, u1} G F) (Functor.Comp.instApplicativeComp.{u1, u1, u1} G F _inst_4 _inst_3) α γ (Function.comp.{succ u1, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} G F γ) (Functor.Comp.mk.{u1, u1, u1} G F γ) (Function.comp.{succ u1, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_4) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} G F (t' γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_4) (t' β) (F (t' γ)) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 F _inst_3 β γ f) (Equiv.traverse.{u1} (fun (α : Type.{u1}) => t α) (fun (α : Type.{u1}) => t' α) eqv _inst_1 G _inst_4 α β g x)))
Case conversion may be inaccurate. Consider using '#align equiv.comp_traverse Equiv.comp_traverseₓ'. -/
protected theorem comp_traverse (f : β → F γ) (g : α → G β) (x : t' α) :
    Equiv.traverse eqv (Comp.mk ∘ Functor.map f ∘ g) x =
      Comp.mk (Equiv.traverse eqv f <$> Equiv.traverse eqv g x) :=
  by simp [Equiv.traverse, comp_traverse, functor_norm] <;> congr <;> ext <;> simp
#align equiv.comp_traverse Equiv.comp_traverse

#print Equiv.naturality /-
protected theorem naturality (f : α → F β) (x : t' α) :
    η (Equiv.traverse eqv f x) = Equiv.traverse eqv (@η _ ∘ f) x := by
  simp only [Equiv.traverse, functor_norm]
#align equiv.naturality Equiv.naturality
-/

#print Equiv.isLawfulTraversable /-
/-- The fact that `t` is a lawful traversable functor carries over the
equivalences to `t'`, with the traversable functor structure given by
`equiv.traversable`. -/
protected def isLawfulTraversable : @IsLawfulTraversable t' (Equiv.traversable eqv)
    where
  to_lawfulFunctor := @Equiv.lawfulFunctor _ _ eqv _ _
  id_traverse := @Equiv.id_traverse _ _
  comp_traverse := @Equiv.comp_traverse _ _
  traverse_eq_map_id := @Equiv.traverse_eq_map_id _ _
  naturality := @Equiv.naturality _ _
#align equiv.is_lawful_traversable Equiv.isLawfulTraversable
-/

#print Equiv.isLawfulTraversable' /-
/-- If the `traversable t'` instance has the properties that `map`,
`map_const`, and `traverse` are equal to the ones that come from
carrying the traversable functor structure from `t` over the
equivalences, then the fact that `t` is a lawful traversable functor
carries over as well. -/
protected def isLawfulTraversable' [_i : Traversable t']
    (h₀ : ∀ {α β} (f : α → β), map f = Equiv.map eqv f)
    (h₁ : ∀ {α β} (f : β), mapConst f = (Equiv.map eqv ∘ Function.const α) f)
    (h₂ :
      ∀ {F : Type u → Type u} [Applicative F],
        ∀ [LawfulApplicative F] {α β} (f : α → F β), traverse f = Equiv.traverse eqv f) :
    IsLawfulTraversable t' :=
  by
  -- we can't use the same approach as for `is_lawful_functor'` because
    -- h₂ needs a `is_lawful_applicative` assumption
    refine' { to_lawfulFunctor := Equiv.lawfulFunctor' eqv @h₀ @h₁.. } <;>
    intros
  · rw [h₂, Equiv.id_traverse]
    infer_instance
  · rw [h₂, Equiv.comp_traverse f g x, h₂]
    congr
    rw [h₂]
    all_goals infer_instance
  · rw [h₂, Equiv.traverse_eq_map_id, h₀] <;> infer_instance
  · rw [h₂, Equiv.naturality, h₂] <;> infer_instance
#align equiv.is_lawful_traversable' Equiv.isLawfulTraversable'
-/

end Equiv

end Equiv


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

! This file was ported from Lean 3 source module topology.category.Locale
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Category.Frm

/-!
# The category of locales

This file defines `Locale`, the category of locales. This is the opposite of the category of frames.
-/

universe u

open CategoryTheory Opposite Order TopologicalSpace

/-- The category of locales. -/
def Locale :=
  Frmᵒᵖderiving LargeCategory
#align Locale Locale

namespace Locale

instance : CoeSort Locale (Type _) :=
  ⟨fun X => X.unop⟩

instance (X : Locale) : Frame X :=
  X.unop.str

/-- Construct a bundled `Locale` from a `frame`. -/
def of (α : Type _) [Frame α] : Locale :=
  op <| Frm.of α
#align Locale.of Locale.of

@[simp]
theorem coe_of (α : Type _) [Frame α] : ↥(of α) = α :=
  rfl
#align Locale.coe_of Locale.coe_of

instance : Inhabited Locale :=
  ⟨of PUnit⟩

end Locale

/-- The forgetful functor from `Top` to `Locale` which forgets that the space has "enough points".
-/
@[simps]
def topToLocale : TopCat ⥤ Locale :=
  topOpToFrame.rightOp
#align Top_to_Locale topToLocale

-- Note, `CompHaus` is too strong. We only need `t0_space`.
instance CompHausToLocale.faithful : Faithful (compHausToTop ⋙ topToLocale.{u}) :=
  ⟨fun X Y f g h => by
    dsimp at h
    exact opens.comap_injective (Quiver.Hom.op_inj h)⟩
#align CompHaus_to_Locale.faithful CompHausToLocale.faithful


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import topology.continuous_function.basic

/-!
# Cocompact continuous maps

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

The type of *cocompact continuous maps* are those which tend to the cocompact filter on the
codomain along the cocompact filter on the domain. When the domain and codomain are Hausdorff, this
is equivalent to many other conditions, including that preimages of compact sets are compact. -/

universes u v w

open filter set

/-! ### Cocompact continuous maps -/

/-- A *cocompact continuous map* is a continuous function between topological spaces which
tends to the cocompact filter along the cocompact filter. Functions for which preimages of compact
sets are compact always satisfy this property, and the converse holds for cocompact continuous maps
when the codomain is Hausdorff (see `cocompact_map.tendsto_of_forall_preimage` and
`cocompact_map.is_compact_preimage`).

Cocompact maps thus generalise proper maps, with which they correspond when the codomain is
Hausdorff. -/
structure cocompact_map (α : Type u) (β : Type v) [topological_space α] [topological_space β]
  extends continuous_map α β : Type (max u v) :=
(cocompact_tendsto' : tendsto to_fun (cocompact α) (cocompact β))

section
set_option old_structure_cmd true

/-- `cocompact_map_class F α β` states that `F` is a type of cocompact continuous maps.

You should also extend this typeclass when you extend `cocompact_map`. -/
class cocompact_map_class (F : Type*) (α β : out_param $ Type*) [topological_space α]
  [topological_space β] extends continuous_map_class F α β :=
(cocompact_tendsto (f : F) : tendsto f (cocompact α) (cocompact β))

end

namespace cocompact_map_class

variables {F α β : Type*} [topological_space α] [topological_space β]
  [cocompact_map_class F α β]

instance : has_coe_t F (cocompact_map α β) := ⟨λ f, ⟨f, cocompact_tendsto f⟩⟩

end cocompact_map_class

export cocompact_map_class (cocompact_tendsto)

namespace cocompact_map

section basics
variables {α β γ δ : Type*} [topological_space α] [topological_space β] [topological_space γ]
  [topological_space δ]

instance : cocompact_map_class (cocompact_map α β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_continuous := λ f, f.continuous_to_fun,
  cocompact_tendsto := λ f, f.cocompact_tendsto' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (cocompact_map α β) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma coe_to_continuous_fun {f : cocompact_map α β} :
  (f.to_continuous_map : α → β) = f := rfl

@[ext] lemma ext {f g : cocompact_map α β} (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h

/-- Copy of a `cocompact_map` with a new `to_fun` equal to the old one. Useful
to fix definitional equalities. -/
protected def copy (f : cocompact_map α β) (f' : α → β) (h : f' = f) : cocompact_map α β :=
{ to_fun := f',
  continuous_to_fun := by {rw h, exact f.continuous_to_fun},
  cocompact_tendsto' := by { simp_rw h, exact f.cocompact_tendsto' } }

@[simp]
lemma coe_copy (f : cocompact_map α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl

lemma copy_eq (f : cocompact_map α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h

@[simp] lemma coe_mk (f : C(α, β)) (h : tendsto f (cocompact α) (cocompact β)) :
  ⇑(⟨f, h⟩ : cocompact_map α β) = f := rfl

section
variable (α)
/-- The identity as a cocompact continuous map. -/
protected def id : cocompact_map α α := ⟨continuous_map.id _, tendsto_id⟩
@[simp] lemma coe_id : ⇑(cocompact_map.id α) = id := rfl
end

instance : inhabited (cocompact_map α α) := ⟨cocompact_map.id α⟩

/-- The composition of cocompact continuous maps, as a cocompact continuous map. -/
def comp (f : cocompact_map β γ) (g : cocompact_map α β) : cocompact_map α γ :=
⟨f.to_continuous_map.comp g, (cocompact_tendsto f).comp (cocompact_tendsto g)⟩

@[simp] lemma coe_comp (f : cocompact_map β γ) (g : cocompact_map α β) :
  ⇑(comp f g) = f ∘ g := rfl

@[simp] lemma comp_apply (f : cocompact_map β γ) (g : cocompact_map α β) (a : α) :
  comp f g a = f (g a) := rfl

@[simp] lemma comp_assoc (f : cocompact_map γ δ) (g : cocompact_map β γ)
  (h : cocompact_map α β) : (f.comp g).comp h = f.comp (g.comp h) := rfl

@[simp] lemma id_comp (f : cocompact_map α β) : (cocompact_map.id _).comp f = f :=
ext $ λ _, rfl

@[simp] lemma comp_id (f : cocompact_map α β) : f.comp (cocompact_map.id _) = f :=
ext $ λ _, rfl

lemma tendsto_of_forall_preimage {f : α → β} (h : ∀ s, is_compact s → is_compact (f ⁻¹' s)) :
  tendsto f (cocompact α) (cocompact β) :=
λ s hs, match mem_cocompact.mp hs with ⟨t, ht, hts⟩ :=
  mem_map.mpr (mem_cocompact.mpr ⟨f ⁻¹' t, h t ht, by simpa using preimage_mono hts⟩) end

/-- If the codomain is Hausdorff, preimages of compact sets are compact under a cocompact
continuous map. -/
lemma is_compact_preimage [t2_space β] (f : cocompact_map α β) ⦃s : set β⦄ (hs : is_compact s) :
  is_compact (f ⁻¹' s) :=
begin
  obtain ⟨t, ht, hts⟩ := mem_cocompact'.mp (by simpa only [preimage_image_preimage, preimage_compl]
    using mem_map.mp (cocompact_tendsto f $ mem_cocompact.mpr ⟨s, hs, compl_subset_compl.mpr
    (image_preimage_subset f _)⟩)),
  exact is_compact_of_is_closed_subset ht (hs.is_closed.preimage $ map_continuous f)
    (by simpa using hts),
end

end basics

end cocompact_map

/-- A homemomorphism is a cocompact map. -/
@[simps] def homeomorph.to_cocompact_map
  {α β : Type*} [topological_space α] [topological_space β] (f : α ≃ₜ β) : cocompact_map α β :=
{ to_fun := f,
  continuous_to_fun := f.continuous,
  cocompact_tendsto' :=
  begin
    refine cocompact_map.tendsto_of_forall_preimage (λ K hK, _),
    erw K.preimage_equiv_eq_image_symm,
    exact hK.image f.symm.continuous,
  end }