import topology.basic categories.cat_limits categories.cat_colimits types2

universes v v' u u' w w'
hott_theory

namespace hott
open hott.set hott.subset hott.categories category_theory.limits category_theory.colimits
  categories.opposite hott.sigma hott.is_trunc hott.trunc

set_option pp.universes true

/- The category of topological spaces and continuous maps. -/
@[hott]
structure Top :=
(carrier : Set)
(top_str : topological_space carrier)

@[hott]
instance Top_to_Set : has_coe_to_sort Top :=
  has_coe_to_sort.mk Set (λ T : Top, T.carrier)

@[hott]
instance topological_space_unbundled (X : Top) :
  topological_space ↥X := X.top_str

variables (X : Top)

namespace topology

/- The set of open sets in a topological space and its lattice structure. -/
@[hott]
def open_sets : Subset (𝒫 ↥X) :=
  {U ∈ (𝒫 ↥X) | is_open ↥X U}

@[hott]
instance : has_coe ↥(open_sets X) (Subset ↥X) :=
  ⟨λ Y : open_sets X, Y.1⟩

@[hott]
protected def open_sets.inter (U V : open_sets X) : open_sets X :=
have U_is_open : is_open ↥X U, from U.2,
have V_is_open : is_open ↥X V, from V.2,
have inter_is_open : is_open ↥X (U.1 ∩ V.1), from
  is_open_inter ↥X U_is_open V_is_open,
⟨U.1 ∩ V.1, inter_is_open⟩

@[hott, instance]
def open_sets_inter : has_inter (open_sets X) :=
⟨open_sets.inter X⟩

@[hott]
def open_sets.iUnion {I : Set} (f : I -> open_sets X) : ↥(open_sets X) :=
have U_i_is_open : ∀ i : I, is_open ↥X (f i), from assume i, (f i).2,
have open_union : is_open ↥X (⋃ᵢ (λ i, (f i).1)), from is_open_iUnion ↥X U_i_is_open,
⟨⋃ᵢ (λ i, (f i).1), open_union⟩

@[hott]
instance open_sets_incl_to_hom {U V : open_sets X} : has_coe ↥(U.1 ⊆ V.1) (U ⟶ V) :=
  ⟨λ i : U.1 ⊆ V.1, i⟩

@[hott]
def open_sets_hom_to_emb {U V : open_sets X} (i : U ⟶ V) : U.1 -> V.1 :=
  assume x, ⟨x, i x x.2⟩

@[hott]
def opens.inf_le_l (U V : open_sets X) : open_sets.inter X U V ⟶ U :=
  inter_sset_l U V

@[hott]
def opens.inf_le_r (U V : open_sets X) : open_sets.inter X U V ⟶ V :=
  inter_sset_r U V

@[hott]
def opens.le_union {I : Set} (f : I -> open_sets X) :
  Π i : I, f i ⟶ open_sets.iUnion X f :=
begin
  intro i,
  change ↥(↑(f i) ⊆ ↑(open_sets.iUnion X f)),
  exact sset_iUnion (λ i, ↑(f i)) i
end

@[hott]
def opens.hom_eq {U V : open_sets X} (f g : U ⟶ V) : f = g :=
  power_set_unique_hom f g

@[hott, reducible]
def nbhds (x : X.carrier) : Subset (𝒫 ↥X) :=
  {U ∈ (𝒫 ↥X) | is_open ↥X U and x ∈ U}

@[hott]
def nbhds_opens_inc (x : X.carrier) : nbhds X x ⊆ open_sets X :=
begin  intros U el, exact el.1  end

@[hott, instance]
def nbhds_precat (x : X.carrier) : precategory (nbhds X x) :=
  subset_precat_precat (nbhds X x)

@[hott]
def nbhds_opens_inc_functor (x : X.carrier) : (nbhds X x)ᵒᵖ ⥤ (open_sets X)ᵒᵖ :=
  opposite_functor (functor_subsets_precat (nbhds_opens_inc X x))

/- As a subset of the power set the set of open sets (and sets of neighborhoods) automatically
   receive a precategory instance. Therefore, we can define a presheaf over a
   topological space with values in a category `C` and its stalks as follows: -/
@[hott]
def presheaf (C : Type u') [category.{v'} C] := (open_sets X)ᵒᵖ ⥤ C

@[hott]
def stalk (C : Type u') [category.{v'} C] [H : has_colimits C] (F : presheaf X C)
  (x : X.carrier) : C :=
have G : (nbhds X x)ᵒᵖ ⥤ C, from nbhds_opens_inc_functor X x ⋙ F,
@colimit (op_Set (pred_Set (nbhds X x))) _ _ _ G (@has_colimit_of_has_colimits C _ H _ _ _)

/- The product of the sections of a presheaf over a family of open sets. -/
@[hott]
def pi_opens {C : Type u} [category.{v} C] [has_products.{v u w'} C]
  {I : Set.{w'}} (U : I -> open_sets X) (F : presheaf X C) : C :=
∏ (λ i : I, F.obj (op (U i)))

/- The product of the sections of a presheaf over the pairwise intersections
   of a family of open sets.-/
@[hott]
def pi_inters {C : Type u} [category.{v} C] [has_products.{v u w'} C]
  {I : Set.{w'}} (U : I -> open_sets X) (F : presheaf X C) : C :=
∏ (λ p : ↥(I × I), F.obj (op (open_sets.inter X (U p.1) (U p.2))))

@[hott, reducible]
def left_res {C : Type u} [category.{v} C] [has_products.{v u w'} C]
  {I : Set.{w'}} (U : I -> open_sets X) (F : presheaf X C) :
  (pi_opens X U F) ⟶ (pi_inters X U F) :=
pi.lift C (λ p : ↥(I × I), pi.π _ p.1 ≫
                        F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2))))

@[hott, reducible]
def right_res {C : Type u} [category.{v} C] [has_products.{v u w'} C]
  {I : Set.{w'}} (U : I -> open_sets X) (F : presheaf X C) :
  (pi_opens X U F) ⟶ (pi_inters X U F) :=
pi.lift C (λ p : ↥I × I, pi.π _ p.2 ≫
                       F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2))))

@[hott, reducible]
def res {C : Type u} [category.{v} C] [has_products.{v u u_2} C]
  {I : Set.{u_2}} (U : I -> open_sets X) (F : presheaf X C) :
  (F.obj (op (open_sets.iUnion X U))) ⟶ (pi_opens X U F) :=
pi.lift C (λ i : I, F.map (hom_op (opens.le_union X U i)))

@[hott]
def w_res {C : Type u} [category.{v} C] [has_products.{v u u_2} C]
  {I : Set} (U : I -> open_sets X) (F : presheaf X C) :
  (res X U F) ≫ (left_res X U F) = (res X U F) ≫ (right_res X U F) :=
have left_eq : Π p : ↥(I × I), ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p =
  F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2) ≫ opens.le_union X U p.1)), from
  assume p,
  calc ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p =
             (res X U F) ≫ ((left_res X U F) ≫ pi.π _ p) : precategory.assoc _ _ _
       ... = (res X U F) ≫ (pi.π _ p.1 ≫ F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2)))) :
             by rwr pi.lift_π_eq C _ p
       ... = ((res X U F) ≫ pi.π _ p.1) ≫ F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2))) :
             (precategory.assoc _ _ _)⁻¹
       ... = F.map (hom_op (opens.le_union X U p.1)) ≫
                                      F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2))) :
             by rwr pi.lift_π_eq C _ p.1
       ... = F.map (hom_op (opens.le_union X U p.1) ≫
                                             hom_op (opens.inf_le_l X (U p.1) (U p.2))) :
             (functor.map_comp F _ _)⁻¹
       ... = F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2) ≫ opens.le_union X U p.1)) :
             by rwr <- hom_op_funct (opens.inf_le_l X (U p.1) (U p.2)) _,
have right_eq : Π p : ↥(I × I), ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p =
  F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2) ≫ opens.le_union X U p.2)), from
  assume p,
  calc ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p =
             (res X U F) ≫ ((right_res X U F) ≫ pi.π _ p) : precategory.assoc _ _ _
       ... = (res X U F) ≫ (pi.π _ p.2 ≫ F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2)))) :
             by rwr pi.lift_π_eq C _ p
       ... = ((res X U F) ≫ pi.π _ p.2) ≫ F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2))) :
             (precategory.assoc _ _ _)⁻¹
       ... = F.map (hom_op (opens.le_union X U p.2)) ≫
                                      F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2))) :
             by rwr pi.lift_π_eq C _ p.2
       ... = F.map (hom_op (opens.le_union X U p.2) ≫
                                             hom_op (opens.inf_le_r X (U p.1) (U p.2))) :
             (functor.map_comp F _ _)⁻¹
       ... = F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2) ≫ opens.le_union X U p.2)) :
             by rwr <- hom_op_funct (opens.inf_le_r X (U p.1) (U p.2)) _,
have incl_eq : Π p : ↥I × I, (opens.inf_le_l X (U p.1) (U p.2) ≫ opens.le_union X U p.1) =
                      (opens.inf_le_r X (U p.1) (U p.2) ≫ opens.le_union X U p.2), from
  assume p, opens.hom_eq X _ _,
have left_right_eq : Π p : ↥I × I, ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p =
  ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p, from assume p,
  calc ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p =
          F.map (hom_op (opens.inf_le_l X (U p.1) (U p.2) ≫ opens.le_union X U p.1)) :
          left_eq p
    ... = F.map (hom_op (opens.inf_le_r X (U p.1) (U p.2) ≫ opens.le_union X U p.2)) :
          by rwr incl_eq p
    ... = ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p : (right_eq p)⁻¹,
have fun_lr_eq : (λ p : ↥I × I, ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p) =
  λ p : ↥I × I, ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p, from
  eq_of_homotopy (λ p, left_right_eq p),
calc (res X U F) ≫ (left_res X U F) = pi.lift C (λ p : ↥I × I,
                          ((res X U F) ≫ (left_res X U F)) ≫ pi.π _ p) :
           pi.hom_is_lift C ((res X U F) ≫ (left_res X U F))
     ... = pi.lift C (λ p : ↥I × I,
                          ((res X U F) ≫ (right_res X U F)) ≫ pi.π _ p) :
           by rwr fun_lr_eq
     ... = (res X U F) ≫ (right_res X U F) :
           (pi.hom_is_lift C ((res X U F) ≫ (right_res X U F)))⁻¹
/- Of course, this proof is way too long. In [mathlib], most of the calculations are simplified,
   but that makes the idea of the proof completely invisible. The challenge is to translate the
   manipulations in the associated commutative diagram to a readable proof. One of the problems
  are the long names. -/

@[hott]
def sheaf_condition_equalizer_products.fork {C : Type u} [category.{v} C]
  [has_products C] {I : Set} (U : I -> open_sets X)
  (F : presheaf X C) : fork (left_res X U F) (right_res X U F) :=
fork.of_i _ _ (res X U F) (w_res X U F)

@[hott]
def sheaf_condition {C : Type u} [category.{v} C] [has_products.{v u u_2} C]
  (F : presheaf X C) := Π {I : Set} (U : I -> open_sets X),
  is_limit (sheaf_condition_equalizer_products.fork X U F)

@[hott]
structure sheaf (C : Type u) [category.{v} C] [has_products.{v u u_2} C] :=
(presheaf : presheaf X C)
(sheaf_condition : sheaf_condition X presheaf)

/- Gluing provides an alternative description of the sheaf condition on set-valued presheafs. -/
@[hott]
def is_gluing (F : presheaf X Set) {I : Set} (U : I -> open_sets X)
  (sf : Π i : I, F.obj (op (U i))) (s : F.obj (op (open_sets.iUnion X U))) : trunctype.{0} -1 :=
prop_resize (to_Prop (∀ i : I, F.map (hom_op (opens.le_union X U i)) s = sf i))

@[hott]
def is_gluing_to_cond (F : presheaf X Set) {I : Set} (U : I -> open_sets X)
  (sf : Π i : I, F.obj (op (U i))) (s : F.obj (op (open_sets.iUnion X U))) :
  is_gluing X F U sf s -> ∀ i : I, F.map (hom_op (opens.le_union X U i)) s = sf i :=
begin
  have P : is_prop (∀ i : I, F.map (hom_op (opens.le_union X U i)) s = sf i), from
    begin apply is_prop_dprod, intro i, apply is_prop.mk, intros p q, exact is_set.elim _ _ end,
  intros ig,
  exact prop_resize_to_prop ig
end

@[hott]
def is_compatible {F : presheaf X Set} {I : Set} {U : I -> open_sets X}
  (sf : Π i : I, F.obj (op (U i))) := ∀ (i j : I),
    F.map (hom_op (opens.inf_le_l X (U i) (U j))) (sf i) =
                                         F.map (hom_op (opens.inf_le_r X (U i) (U j))) (sf j)

@[hott]
def cone_res_is_compatible {F : presheaf X Set} {I : Set} {U : I -> open_sets X}
  {S : cone (parallel_pair (@left_res X _ _ set_has_products _ U F)
                             (@right_res X _ _ set_has_products _ U F))} :
  ∀ Sf : S.X, @is_compatible X F I U (S.π.app wp_pair.up Sf).1 :=
begin
  intro Sf,
  let sf : ↥(@pi_opens X _ _ set_has_products _ U F) := S.π.app wp_pair.up Sf,
  apply all_prod_all, intro p,
  have H1 : (pi.π (λ (i : ↥I), F.obj (op (U i))) p.fst ≫
                    F.map (hom_op (opens.inf_le_l X (U p.fst) (U p.snd)))) =
                          (@left_res X _ _ (set_has_products) _ U F ≫ pi.π _ p), from
    inverse (pi.lift_π_eq _ _ p),
  have H2 : (@right_res X _ _ (set_has_products) _ U F ≫ pi.π _ p) =
            (pi.π (λ (i : ↥I), F.obj (op (U i))) p.snd ≫
                          F.map (hom_op (opens.inf_le_r X (U p.fst) (U p.snd)))), from
    pi.lift_π_eq _ _ p,
  let hl : ↥(@has_hom.hom _ walking_parallel_pair_has_hom wp_pair.up wp_pair.down) :=
    wp_pair_hom.left,
  have H3 : (S.π.app wp_pair.up) ≫ (@left_res X _ _ (set_has_products) _ U F) =
                (𝟙 S.X) ≫ (S.π.app wp_pair.down), from
    inverse (S.π.naturality hl),
  let hr : ↥(@has_hom.hom _ walking_parallel_pair_has_hom wp_pair.up wp_pair.down) :=
    wp_pair_hom.right,
  have H4 : (S.π.app wp_pair.up) ≫ (@right_res X _ _ (set_has_products) _ U F) =
               (𝟙 S.X) ≫ (S.π.app wp_pair.down), from
    inverse (S.π.naturality hr),
  calc (pi.π (λ (i : ↥I), F.obj (op (U i))) p.fst ≫
            F.map (hom_op (opens.inf_le_l X (U p.fst) (U p.snd)))) sf =
                  (@left_res X _ _ (set_has_products) _ U F ≫ pi.π _ p) sf : by rwr H1
       ... = ((S.π.app wp_pair.up) ≫ (@left_res X _ _ (set_has_products) _ U F ≫
                                                                      pi.π _ p)) Sf : rfl
       ... = (((S.π.app wp_pair.up) ≫ (@left_res X _ _ (set_has_products) _ U F)) ≫
                                                                      pi.π _ p) Sf :
             by rwr precategory.assoc _ _ _
       ... = (((𝟙 S.X) ≫ (S.π.app wp_pair.down)) ≫ pi.π _ p) Sf : by rwr H3
       ... = ((S.π.app wp_pair.up) ≫ (@right_res X _ _ (set_has_products) _ U F) ≫
                                                                      pi.π _ p) Sf :
             by rwr inverse H4
       ... = ((S.π.app wp_pair.up) ≫ (@right_res X _ _ (set_has_products) _ U F) ≫
                                                                      pi.π _ p) Sf :
             by rwr inverse (precategory.assoc _ _ _)
       ... = (@right_res X _ _ (set_has_products) _ U F ≫ pi.π _ p) sf : rfl
       ... = (pi.π (λ (i : ↥I), F.obj (op (U i))) p.snd ≫
                      F.map (hom_op (opens.inf_le_r X (U p.fst) (U p.snd)))) sf : by rwr H2
end

@[hott]
def sheaf_condition_unique_gluing (F : presheaf X Set) {I : Set} (U : I -> open_sets X) :=
  ∀ (sf : Π i : I, F.obj (op (U i))), is_compatible X sf -> unique_elem (is_gluing X F U sf)

@[hott]
def lift_of_unique_gluing (F : presheaf X Set) {I : Set} (U : I -> open_sets X) :
  sheaf_condition_unique_gluing X F U ->
  ∀ (S : cone (parallel_pair (@left_res X _ _ set_has_products _ U F)
                             (@right_res X _ _ set_has_products _ U F))),
  S.X ⟶ (sheaf_condition_equalizer_products.fork X U F).X :=
begin
  intros sc_ug S Sf,
  let sf : ↥(@pi_opens X _ _ set_has_products _ U F) := S.π.app wp_pair.up Sf,
  apply unique_to_elem (is_gluing X F U sf.1), apply sc_ug,
  exact cone_res_is_compatible X Sf
end

@[hott]
def sheaf_condition_of_unique_gluing (F : presheaf X Set) :
  (∀ {I : Set} (U : I -> open_sets X), sheaf_condition_unique_gluing X F U) ->
  @sheaf_condition X _ _ set_has_products F :=
begin
  intros sc_ug I U,
  fapply is_limit.mk,
  { apply lift_of_unique_gluing X F U, exact sc_ug U },
  { intro S,
    have fac_up : (lift_of_unique_gluing X F U (sc_ug U) S) ≫ (res X U F) = S.π.app wp_pair.up, from
      begin
        apply eq_of_homotopy, intro Sf,
        let sf : ↥(@pi_opens X _ _ set_has_products _ U F) := S.π.app wp_pair.up Sf,
        fapply sigma_eq,
        { apply eq_of_homotopy, intro i,
          let lift_Sf := lift_of_unique_gluing X F U (sc_ug U) S Sf,
          change F.map (hom_op (opens.le_union X U i)) lift_Sf = sf.1 i,
          have gc : ↥(is_gluing X F U sf.1 lift_Sf), from
            unique_to_pred (is_gluing X F U sf.1) (sc_ug U sf.1 (cone_res_is_compatible X Sf)),
          exact is_gluing_to_cond X F U sf.1 lift_Sf gc i },
        { apply pathover_of_tr_eq, exact is_prop.elim _ _ }
      end,
    intro j, hinduction j,
    { exact fac_up },
    { let hl : ↥(@has_hom.hom _ walking_parallel_pair_has_hom wp_pair.up wp_pair.down) :=
        wp_pair_hom.left,
      have H : (S.π.app wp_pair.up) ≫ (@left_res X _ _ (set_has_products) _ U F) =
                 (𝟙 S.X) ≫ (S.π.app wp_pair.down), from
        inverse (S.π.naturality hl),
      calc lift_of_unique_gluing X F U (sc_ug U) S ≫ (res X U F ≫
                                                    @left_res X _ _ (set_has_products) _ U F) =
                 (lift_of_unique_gluing X F U (sc_ug U) S ≫ res X U F) ≫ left_res X U F :
                 by rwr precategory.assoc _ _ _
           ... = S.π.app wp_pair.up ≫ @left_res X _ _ (set_has_products) _ U F : by rwr fac_up
           ... = (𝟙 S.X) ≫ (S.π.app wp_pair.down) : by rwr H
           ... = S.π.app wp_pair.down : precategory.id_comp _ } },
  { intros S m m_lift, apply eq_of_homotopy, intro Sf,
    let sf : ↥(@pi_opens X _ _ set_has_products _ U F) := S.π.app wp_pair.up Sf,
    let lift := lift_of_unique_gluing X F U (sc_ug U) S,
    have H : (sheaf_condition_equalizer_products.fork X U F).π.app wp_pair.up (m Sf) = sf, from
      homotopy_of_eq (m_lift wp_pair.up) Sf,
    have m_Sf_ig : ↥(is_gluing X F U sf.1 (m Sf)), from
      prop_to_prop_resize (λ i, homotopy_of_eq (ap sigma.fst H) i),
    have lift_ig : ↥(is_gluing X F U sf.1 (lift Sf)), from
      unique_to_pred (is_gluing X F U sf.1) (sc_ug U sf.1 (cone_res_is_compatible X Sf)),
    let P := unique_to_uniq (is_gluing X F U sf.1) (sc_ug U sf.1 (cone_res_is_compatible X Sf)),
    exact ap sigma.fst (@is_prop.elim (Σ (a : ↥(F.obj (op (open_sets.iUnion X U)))),
                               ↥(is_gluing X F U sf.fst a)) P ⟨m Sf, m_Sf_ig⟩ ⟨lift Sf, lift_ig⟩) }
end

end topology

@[hott]
structure PresheafedSpace (C : Type u) [category.{v} C] :=
  (carrier : Top)
  (presheaf : topology.presheaf carrier C)

@[hott]
structure SheafedSpace (C : Type u) [category.{v} C] [has_products C] extends
  PresheafedSpace C :=
  (sheaf_condition : topology.sheaf_condition carrier presheaf)

/- We construct (pre-)sheaves of sections to a family of sets over open subsets of a
   topological space that satisfy a (pre-)local predicate.

   We need to take functions with values in sets because otherwise the homomorphisms in
   the presheaf category will not be sets. Therefore, the presheaf category also will be
   `Set`. -/
open topology

@[hott, reducible]
def ss_section (U : open_sets X) (T : X.carrier -> Set) :=
  Π x : U.1, (T x).carrier

@[hott]
def ss_section_Set (U : open_sets X) (T : X.carrier -> Set) : Set :=
  have is_set_ss_section : is_set (ss_section X U T), from
    @is_set_dmap (pred_Set U.1) (λ x, T x.1),
  Set.mk (ss_section X U T) is_set_ss_section

@[hott, reducible]
def res_ss_section {U V : open_sets X} (i : U ⟶ V) {T : X.carrier -> Set} :
  ss_section_Set X V T -> ss_section_Set X U T :=
begin intros f x, let y : ↥V.1 := ⟨x.1, i x x.2⟩, exact f y end

@[hott]
def id_res_section {U : open_sets X} {T : X.carrier -> Set} :
  Π f : ss_section_Set X U T, res_ss_section X (𝟙 U) f = f :=
begin
  intro f, apply eq_of_homotopy, intro x,
  hinduction x with x' pred_x, refl
end

@[hott]
def comp_res_section {U V W : open_sets X} {T : X.carrier -> Set}
  (i : U ⟶ V) (j : V ⟶ W) : Π (f : ss_section_Set X W T),
    res_ss_section X (i ≫ j) f = (res_ss_section X i) (res_ss_section X j f) :=
begin
  intro f, apply eq_of_homotopy, intro x,
  hinduction x with x' pred_x, refl
end

@[hott]
structure prelocal_predicate (T : X.carrier -> Set) :=
  (pred : Π {U : open_sets X}, ss_section X U T → trunctype.{0} -1)
  (res : ∀ {U V : open_sets X} (i : U ⟶ V) (f : ss_section X V T)
           (h : pred f), pred (res_ss_section X i f))

@[hott]
def subpresheaf_of_sections {T : X.carrier -> Set} (P : prelocal_predicate X T) :
  presheaf X Set :=
begin
  fapply categories.functor.mk,
  { intro U, exact pred_Set {f ∈ ss_section_Set X (unop U) T | P.pred f} },
  { intros U V i f, fapply sigma.mk,
    { exact res_ss_section X (hom_unop i) f.1 },
    { exact P.res (hom_unop i) f.1 f.2 } },
  { intro U, apply eq_of_homotopy, intro f,
    fapply sigma_eq,
    { exact id_res_section X f.1 },
    { apply pathover_of_tr_eq, apply is_prop.elim } },
  { intros U V W i j, apply eq_of_homotopy, intro f,
    fapply sigma_eq,
    { exact comp_res_section X (hom_unop j) (hom_unop i) f.1 },
    { apply pathover_of_tr_eq, apply is_prop.elim } }
end

@[hott]
def compat_section {T : X.carrier -> Set} (P : prelocal_predicate X T) {I : Set}
  {U : I -> open_sets X} (sf : Π i : I, (subpresheaf_of_sections X P).obj (op (U i))) :
  is_compatible X sf -> ∀ (i j : I) (x : X.carrier) (eli : x ∈ (U i).1) (elj : x ∈ (U j).1),
                          (sf i).1 ⟨x, eli⟩ = (sf j).1 ⟨x, elj⟩ :=
begin
  intros comp i j x eli elj,
  have el_ij : ↥(x ∈ (open_sets.inter X (U i) (U j))), from ⟨eli, elj⟩,
  have Hi : eli = opens.inf_le_l X (U i) (U j) x el_ij, from is_prop.elim _ _,
  have Hj : elj = opens.inf_le_r X (U i) (U j) x el_ij, from is_prop.elim _ _,
  rwr Hi, rwr Hj, exact homotopy_of_eq (ap sigma.fst (comp i j)) ⟨x, el_ij⟩
end

@[hott]
def glued_section {T : X.carrier -> Set} (P : prelocal_predicate X T) {I : Set}
  {U : I -> open_sets X} (sf : Π i : I, (subpresheaf_of_sections X P).obj (op (U i))) :
  is_compatible X sf -> (ss_section_Set X (open_sets.iUnion X U) T) :=
begin
  intro is_comp,
  intro x, let ind_x := Σ i : I, ↑x ∈ (U i).1,
  have pix : ↥∥ind_x∥, from prop_resize_to_prop x.2,
  let sf_ind_x : ind_x -> T ↑x := λ ix, (sf ix.1).1 ⟨x.1, ix.2⟩,
  have P : is_prop (Σ sx : T ↑x, image sf_ind_x sx), from
    begin
      apply is_prop.mk, intros sx_im₁ sx_im₂, fapply sigma_eq,
      { apply @trunc.elim2 _ (fiber sf_ind_x sx_im₁.1) (fiber sf_ind_x sx_im₂.1)
                        (sx_im₁.1 = sx_im₂.1) (is_prop.mk (@is_set.elim _ _ _ _)),
        { intros fib₁ fib₂, rwr <- fib₁.2, rwr <- fib₂.2,
          exact compat_section X P sf is_comp fib₁.1.1 fib₂.1.1 x.1 fib₁.1.2 fib₂.1.2 },
        { exact sx_im₁.2 },
        { exact sx_im₂.2 } },
      { apply pathover_of_tr_eq, exact is_prop.elim _ _ }
    end,
  apply @sigma.fst _ (λ sx : T ↑x, image sf_ind_x sx),
  apply @untrunc_of_is_trunc _ _ P,
  apply @trunc_functor _ (Σ (sx : ↥(T ↑x)), ↥(image sf_ind_x sx)) -1
          (λ ix : ind_x, ⟨sf_ind_x ix, tr (fiber.mk ix (@idp _ (sf_ind_x ix)))⟩),
  exact pix

end

@[hott]
def res_glued_section {T : X.carrier -> Set} (P : prelocal_predicate X T) {I : Set}
  {U : I -> open_sets X} (sf : Π i : I, (subpresheaf_of_sections X P).obj (op (U i)))
  (is_comp : is_compatible X sf) : ∀ i : I,
  res_ss_section X (opens.le_union X U i) (glued_section X P sf is_comp) = (sf i).1 :=
begin
  intro i, apply eq_of_homotopy, intro x,
  let xU : ↥(open_sets.iUnion X U) := ⟨x.1, (opens.le_union X U i) x x.2⟩,
  let ind_x := (Σ i : I, ↑xU ∈ (U i).1), let ix : ind_x := ⟨i, x.2⟩,
  let sf_ind_x : ind_x -> T ↑xU := λ ix, (sf ix.1).1 ⟨x.1, ix.2⟩,
  have P : is_prop (Σ sx : T ↑x, image sf_ind_x sx), from --need it a second time
    begin
      apply is_prop.mk, intros sx_im₁ sx_im₂, fapply sigma_eq,
      { apply @trunc.elim2 _ (fiber sf_ind_x sx_im₁.1) (fiber sf_ind_x sx_im₂.1)
                        (sx_im₁.1 = sx_im₂.1) (is_prop.mk (@is_set.elim _ _ _ _)),
        { intros fib₁ fib₂, rwr <- fib₁.2, rwr <- fib₂.2,
          exact compat_section X P sf is_comp fib₁.1.1 fib₂.1.1 x.1 fib₁.1.2 fib₂.1.2 },
        { exact sx_im₁.2 },
        { exact sx_im₂.2 } },
      { apply pathover_of_tr_eq, exact is_prop.elim _ _ }
    end,
  change (@untrunc_of_is_trunc (Σ (sx : ↥(T ↑xU)), ↥(image sf_ind_x sx)) _ _ _).1 =
                                                                           (sf i).fst x,
  rwr @is_prop.elim (Σ (sx : ↥(T ↑xU)), ↥(image sf_ind_x sx)) P (@untrunc_of_is_trunc _ _ _ _)
                   ⟨sf_ind_x ix, tr (fiber.mk ix (@idp _ (sf_ind_x ix)))⟩,
  change ((sf i).1 ⟨x.1, x.2⟩ : T ↑(⟨x.1, x.2⟩ : Σ y : X.carrier, y ∈ (U i).1)) =
                                                            ((sf i).fst x : T x.1),
  rwr <- sigma.eta x
end

@[hott]
def gluings_are_unique {T : X.carrier -> Set} (P : prelocal_predicate X T) {I : Set}
  {U : I -> open_sets X} (sf : Π i : I, (subpresheaf_of_sections X P).obj (op (U i)))
  (is_comp : is_compatible X sf) :
  ∀ s₁ s₂ : (subpresheaf_of_sections X P).obj (op (open_sets.iUnion X U)),
    (is_gluing X (subpresheaf_of_sections X P) U sf s₁) ->
      (is_gluing X (subpresheaf_of_sections X P) U sf s₂) -> s₁ = s₂ :=
begin
  intros s₁ s₂ gs₁ gs₂,
  fapply sigma_eq,
  { apply eq_of_homotopy, intro x,
    let ind_x := Σ i : I, ↑x ∈ (U i).1,
    have pix : ↥∥ind_x∥, from prop_resize_to_prop x.2,
    fapply @untrunc_of_is_trunc _ -1,
    apply @trunc_functor ind_x _ -1,
    { intro ix,
      have p : x = ⟨x.1, opens.le_union X U ix.1 (⟨x.1, ix.2⟩ : (U ix.1).1) ix.2⟩, from
        begin fapply sigma_eq, refl, apply pathover_of_tr_eq, exact is_prop.elim _ _ end,
      rwr p,
      change ((subpresheaf_of_sections X P).map (hom_op (opens.le_union X U ix.fst)) s₁).fst
                                                                              ⟨x.fst, ix.snd⟩ =
             ((subpresheaf_of_sections X P).map (hom_op (opens.le_union X U ix.fst)) s₂).fst
                                                                              ⟨x.fst, ix.snd⟩,
      rwr homotopy_of_eq (ap sigma.fst (prop_resize_to_prop gs₁ ix.1)) ⟨x.1, ix.2⟩,
      rwr homotopy_of_eq (ap sigma.fst (prop_resize_to_prop gs₂ ix.1)) ⟨x.1, ix.2⟩ },
    { exact pix } },
  { apply pathover_of_tr_eq, exact is_prop.elim _ _ }
end

@[hott]
structure local_predicate (T : X.carrier -> Set) extends prelocal_predicate X T :=
  (locality : ∀ {U : open_sets X} (f : ss_section X U T) (w : ∀ x : U.1,
     ∥ Σ (V : open_sets X) (m : ↑x ∈ V.1) (i : V ⟶ U), pred (res_ss_section X i f) ∥),
     pred f)

/- Universe levels are not determined automatically. -/
@[hott]
def subsheaf_of_sections {T : X.carrier -> Set} (P : local_predicate X T) :
  @sheaf X Set.{max u_1 u_2 u'} Set_category set_has_products.{u_2 (max u_1 u')} :=
begin
  fapply sheaf.mk,
  { exact subpresheaf_of_sections X P.to_prelocal_predicate },
  { apply sheaf_condition_of_unique_gluing.{u_1 u_2 (max u_1 u')} X
                                   ((subpresheaf_of_sections X P.to_prelocal_predicate)),
    intros I U sf is_comp, fapply prod.mk,
    { fapply sigma.mk,
      { fapply sigma.mk, --construction of glued section
        { exact glued_section X P.to_prelocal_predicate sf is_comp },
        { apply P.locality, intro x, --glued section satisfies predicate
          let ind_x := Σ i : I, ↑x ∈ (U i).1,
          have pix : ↥∥ind_x∥, from prop_resize_to_prop x.2,
          apply @trunc_functor ind_x _ -1,
          { intro ix,
            fapply sigma.mk, exact (U ix.1),
            fapply sigma.mk, exact ix.2,
            fapply sigma.mk, exact opens.le_union X U ix.1,
            rwr res_glued_section, exact (sf ix.1).2 },
          { exact pix } } },
      { apply prop_to_prop_resize, intro i, fapply sigma_eq, --glued section is gluing
        { exact res_glued_section X P.to_prelocal_predicate sf is_comp i },
        { apply pathover_of_tr_eq, exact is_prop.elim _ _ } } },
    { apply is_prop.mk,  --glued section is unique
      intros s₁ s₂, fapply sigma_eq,
      { exact gluings_are_unique X P.to_prelocal_predicate sf is_comp s₁.1 s₂.1 s₁.2 s₂.2 },
      { apply pathover_of_tr_eq, exact is_prop.elim _ _ } }  }
end

/- If a category `C` has a faithful functor to `Set` we can construct a sheaf of sections
   with values in the sets associated with the objects of `C`, as a sheaf with values in `C`
   that uniquely factorizes the sheaf of sections with the faithful functor.

   We first construct the sheaf and then show the unique factorization. -/
@[hott]
def subsheaf_of_sections_in_catobj (C : Type u) [category.{v} C] [hp : has_products C]
  (F : C ⥤ Set) (H : is_faithful_functor _ _ F) (T : X.carrier -> C)
  (P : local_predicate X (F.obj ∘ T)) : @sheaf X C _ hp :=
begin
  fapply sheaf.mk,
  { fapply categories.functor.mk,
    { intro U, exact @pi_obj _ _ _ (λ x : pred_Set (unop U).1, T x.1)
                      (@has_product_of_has_products _ _ hp _ _) },
    { sorry },
    { sorry },
    { sorry } },
  { sorry }
end

/-   An example uses the forgetful functor on a category of structured sets. -/

end hott


macro "foo" x:ident : command =>
  `(structure Foo where
      val : Nat
      prop : val = 42
    def f (x : Foo) := x.val
    def g : Foo := { val := 42, prop := by decide }
    theorem $x:ident (x : Foo) : f x = 42 := by simp [f, x.prop] )

foo test
#print test


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.repr
import Mathlib.Lean3Lib.init.data.prod
import Mathlib.Lean3Lib.init.data.sum.basic

universes l u

namespace Mathlib

inductive ordering
where
| lt : ordering
| eq : ordering
| gt : ordering

protected instance ordering.has_repr : has_repr ordering :=
  has_repr.mk fun (s : ordering) => sorry

namespace ordering

def swap : ordering → ordering :=
  sorry

def or_else : ordering → ordering → ordering :=
  sorry

theorem swap_swap (o : ordering) : swap (swap o) = o :=
  ordering.cases_on o (idRhs (swap (swap lt) = swap (swap lt)) rfl) (idRhs (swap (swap eq) = swap (swap eq)) rfl)
    (idRhs (swap (swap gt) = swap (swap gt)) rfl)

end ordering

def cmp_using {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (a : α) (b : α) : ordering :=
  ite (lt a b) ordering.lt (ite (lt b a) ordering.gt ordering.eq)

def cmp {α : Type u} [HasLess α] [DecidableRel Less] (a : α) (b : α) : ordering :=
  cmp_using Less a b

protected instance ordering.decidable_eq : DecidableEq ordering :=
  fun (a b : ordering) => sorry


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.natural_isomorphism
import Mathlib.category_theory.eq_to_hom
import Mathlib.data.sigma.basic
import Mathlib.category_theory.pi.basic
import Mathlib.PostPort

universes w₁ v₁ u₁ l u₂ v₂ w₂ w₃

namespace Mathlib

/-!
# Disjoint union of categories

We define the category structure on a sigma-type (disjoint union) of categories.
-/

namespace category_theory

namespace sigma

/--
The type of morphisms of a disjoint union of categories: for `X : C i` and `Y : C j`, a morphism
`(i, X) ⟶ (j, Y)` if `i = j` is just a morphism `X ⟶ Y`, and if `i ≠ j` there are no such morphisms.
-/
inductive sigma_hom {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] : (sigma fun (i : I) => C i) → (sigma fun (i : I) => C i) → Type (max w₁ v₁ u₁)
where
| mk : {i : I} → {X Y : C i} → (X ⟶ Y) → sigma_hom (sigma.mk i X) (sigma.mk i Y)

namespace sigma_hom

/-- The identity morphism on an object. -/
def id {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (X : sigma fun (i : I) => C i) : sigma_hom X X :=
  sorry

protected instance inhabited {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (X : sigma fun (i : I) => C i) : Inhabited (sigma_hom X X) :=
  { default := id X }

/-- Composition of sigma homomorphisms. -/
def comp {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {X : sigma fun (i : I) => C i} {Y : sigma fun (i : I) => C i} {Z : sigma fun (i : I) => C i} : sigma_hom X Y → sigma_hom Y Z → sigma_hom X Z :=
  sorry

protected instance sigma.category_theory.category_struct {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] : category_struct (sigma fun (i : I) => C i) :=
  category_struct.mk id fun (X Y Z : sigma fun (i : I) => C i) (f : X ⟶ Y) (g : Y ⟶ Z) => comp f g

@[simp] theorem comp_def {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (i : I) (X : C i) (Y : C i) (Z : C i) (f : X ⟶ Y) (g : Y ⟶ Z) : comp (mk f) (mk g) = mk (f ≫ g) :=
  rfl

theorem assoc {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (X : sigma fun (i : I) => C i) (Y : sigma fun (i : I) => C i) (Z : sigma fun (i : I) => C i) (W : sigma fun (i : I) => C i) (f : X ⟶ Y) (g : Y ⟶ Z) (h : Z ⟶ W) : (f ≫ g) ≫ h = f ≫ g ≫ h := sorry

theorem id_comp {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (X : sigma fun (i : I) => C i) (Y : sigma fun (i : I) => C i) (f : X ⟶ Y) : 𝟙 ≫ f = f := sorry

theorem comp_id {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (X : sigma fun (i : I) => C i) (Y : sigma fun (i : I) => C i) (f : X ⟶ Y) : f ≫ 𝟙 = f := sorry

end sigma_hom

protected instance sigma {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] : category (sigma fun (i : I) => C i) :=
  category.mk

/-- The inclusion functor into the disjoint union of categories. -/
@[simp] theorem incl_map {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (i : I) (X : C i) (Y : C i) : ∀ (ᾰ : X ⟶ Y), functor.map (incl i) ᾰ = sigma_hom.mk ᾰ :=
  fun (ᾰ : X ⟶ Y) => Eq.refl (functor.map (incl i) ᾰ)

@[simp] theorem incl_obj {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {i : I} (X : C i) : functor.obj (incl i) X = sigma.mk i X :=
  rfl

protected instance incl.category_theory.full {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (i : I) : full (incl i) :=
  full.mk fun (X Y : C i) (_x : functor.obj (incl i) X ⟶ functor.obj (incl i) Y) => sorry

protected instance incl.category_theory.faithful {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] (i : I) : faithful (incl i) :=
  faithful.mk

/--
To build a natural transformation over the sigma category, it suffices to specify it restricted to
each subcategory.
-/
def nat_trans {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] {F : (sigma fun (i : I) => C i) ⥤ D} {G : (sigma fun (i : I) => C i) ⥤ D} (h : (i : I) → incl i ⋙ F ⟶ incl i ⋙ G) : F ⟶ G :=
  nat_trans.mk fun (_x : sigma fun (i : I) => C i) => sorry

@[simp] theorem nat_trans_app {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] {F : (sigma fun (i : I) => C i) ⥤ D} {G : (sigma fun (i : I) => C i) ⥤ D} (h : (i : I) → incl i ⋙ F ⟶ incl i ⋙ G) (i : I) (X : C i) : nat_trans.app (nat_trans h) (sigma.mk i X) = nat_trans.app (h i) X :=
  rfl

/-- (Implementation). An auxiliary definition to build the functor `desc`. -/
def desc_map {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (X : sigma fun (i : I) => C i) (Y : sigma fun (i : I) => C i) : (X ⟶ Y) → (functor.obj (F (sigma.fst X)) (sigma.snd X) ⟶ functor.obj (F (sigma.fst Y)) (sigma.snd Y)) :=
  sorry

/--
Given a collection of functors `F i : C i ⥤ D`, we can produce a functor `(Σ i, C i) ⥤ D`.

The produced functor `desc F` satisfies: `incl i ⋙ desc F ≅ F i`, i.e. restricted to just the
subcategory `C i`, `desc F` agrees with `F i`, and it is unique (up to natural isomorphism) with
this property.

This witnesses that the sigma-type is the coproduct in Cat.
-/
@[simp] theorem desc_obj {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (X : sigma fun (i : I) => C i) : functor.obj (desc F) X = functor.obj (F (sigma.fst X)) (sigma.snd X) :=
  Eq.refl (functor.obj (desc F) X)

@[simp] theorem desc_map_mk {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) {i : I} (X : C i) (Y : C i) (f : X ⟶ Y) : functor.map (desc F) (sigma_hom.mk f) = functor.map (F i) f :=
  rfl

/--
This shows that when `desc F` is restricted to just the subcategory `C i`, `desc F` agrees with
`F i`.
-/
-- We hand-generate the simp lemmas about this since they come out cleaner.

def incl_desc {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (i : I) : incl i ⋙ desc F ≅ F i :=
  nat_iso.of_components (fun (X : C i) => iso.refl (functor.obj (incl i ⋙ desc F) X)) sorry

@[simp] theorem incl_desc_hom_app {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (i : I) (X : C i) : nat_trans.app (iso.hom (incl_desc F i)) X = 𝟙 :=
  rfl

@[simp] theorem incl_desc_inv_app {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (i : I) (X : C i) : nat_trans.app (iso.inv (incl_desc F i)) X = 𝟙 :=
  rfl

/--
If `q` when restricted to each subcategory `C i` agrees with `F i`, then `q` is isomorphic to
`desc F`.
-/
def desc_uniq {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (q : (sigma fun (i : I) => C i) ⥤ D) (h : (i : I) → incl i ⋙ q ≅ F i) : q ≅ desc F :=
  nat_iso.of_components (fun (_x : sigma fun (i : I) => C i) => sorry) sorry

@[simp] theorem desc_uniq_hom_app {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (q : (sigma fun (i : I) => C i) ⥤ D) (h : (i : I) → incl i ⋙ q ≅ F i) (i : I) (X : C i) : nat_trans.app (iso.hom (desc_uniq F q h)) (sigma.mk i X) = nat_trans.app (iso.hom (h i)) X :=
  rfl

@[simp] theorem desc_uniq_inv_app {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] (F : (i : I) → C i ⥤ D) (q : (sigma fun (i : I) => C i) ⥤ D) (h : (i : I) → incl i ⋙ q ≅ F i) (i : I) (X : C i) : nat_trans.app (iso.inv (desc_uniq F q h)) (sigma.mk i X) = nat_trans.app (iso.inv (h i)) X :=
  rfl

/--
If `q₁` and `q₂` when restricted to each subcategory `C i` agree, then `q₁` and `q₂` are isomorphic.
-/
@[simp] theorem nat_iso_inv {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : Type u₂} [category D] {q₁ : (sigma fun (i : I) => C i) ⥤ D} {q₂ : (sigma fun (i : I) => C i) ⥤ D} (h : (i : I) → incl i ⋙ q₁ ≅ incl i ⋙ q₂) : iso.inv (nat_iso h) = nat_trans fun (i : I) => iso.inv (h i) :=
  Eq.refl (iso.inv (nat_iso h))

/-- A function `J → I` induces a functor `Σ j, C (g j) ⥤ Σ i, C i`. -/
def map {I : Type w₁} (C : I → Type u₁) [(i : I) → category (C i)] {J : Type w₂} (g : J → I) : (sigma fun (j : J) => C (g j)) ⥤ sigma fun (i : I) => C i :=
  desc fun (j : J) => incl (g j)

@[simp] theorem map_obj {I : Type w₁} (C : I → Type u₁) [(i : I) → category (C i)] {J : Type w₂} (g : J → I) (j : J) (X : C (g j)) : functor.obj (map C g) (sigma.mk j X) = sigma.mk (g j) X :=
  rfl

@[simp] theorem map_map {I : Type w₁} (C : I → Type u₁) [(i : I) → category (C i)] {J : Type w₂} (g : J → I) {j : J} {X : C (g j)} {Y : C (g j)} (f : X ⟶ Y) : functor.map (map C g) (sigma_hom.mk f) = sigma_hom.mk f :=
  rfl

/--
The functor `sigma.map C g` restricted to the subcategory `C j` acts as the inclusion of `g j`.
-/
@[simp] theorem incl_comp_map_hom_app {I : Type w₁} (C : I → Type u₁) [(i : I) → category (C i)] {J : Type w₂} (g : J → I) (j : J) (X : C (g j)) : nat_trans.app (iso.hom (incl_comp_map C g j)) X = 𝟙 :=
  Eq.refl 𝟙

/-- The functor `sigma.map` applied to the identity function is just the identity functor. -/
@[simp] theorem map_id_hom_app (I : Type w₁) (C : I → Type u₁) [(i : I) → category (C i)] (_x : sigma fun (i : I) => (fun (i : I) => (fun (i : I) => C (id i)) i) i) : nat_trans.app (iso.hom (map_id I C)) _x =
  nat_trans._match_1
    (fun (i : I) => iso.hom (nat_iso.of_components (fun (X : C i) => iso.refl (sigma.mk i X)) (map_id._proof_1 I C i)))
    _x := sorry

/-- The functor `sigma.map` applied to a composition is a composition of functors. -/
@[simp] theorem map_comp_hom_app {I : Type w₁} (C : I → Type u₁) [(i : I) → category (C i)] {J : Type w₂} {K : Type w₃} (f : K → J) (g : J → I) (X : sigma fun (i : K) => (fun (j : K) => function.comp C g (f j)) i) : nat_trans.app (iso.hom (map_comp C f g)) X =
  iso.hom
    (desc_uniq._match_1 (fun (j : K) => incl (g (f j))) (map (C ∘ g) f ⋙ map C g)
      (fun (k : K) => iso_whisker_right (incl_comp_map (C ∘ g) f k) (map C g) ≪≫ incl_comp_map C g (f k)) X) := sorry

namespace functor

/--
Assemble an `I`-indexed family of functors into a functor between the sigma types.
-/
def sigma {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : I → Type u₁} [(i : I) → category (D i)] (F : (i : I) → C i ⥤ D i) : (sigma fun (i : I) => C i) ⥤ sigma fun (i : I) => D i :=
  desc fun (i : I) => F i ⋙ incl i

end functor

namespace nat_trans

/--
Assemble an `I`-indexed family of natural transformations into a single natural transformation.
-/
def sigma {I : Type w₁} {C : I → Type u₁} [(i : I) → category (C i)] {D : I → Type u₁} [(i : I) → category (D i)] {F : (i : I) → C i ⥤ D i} {G : (i : I) → C i ⥤ D i} (α : (i : I) → F i ⟶ G i) : functor.sigma F ⟶ functor.sigma G :=
  nat_trans.mk fun (f : sigma fun (i : I) => C i) => sigma_hom.mk (nat_trans.app (α (sigma.fst f)) (sigma.snd f))


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.adjunction.basic
import category_theory.opposites
import category_theory.groupoid

/-!
# Facts about epimorphisms and monomorphisms.

The definitions of `epi` and `mono` are in `category_theory.category`,
since they are used by some lemmas for `iso`, which is used everywhere.
-/

universes v₁ v₂ u₁ u₂

namespace category_theory

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

instance unop_mono_of_epi {A B : Cᵒᵖ} (f : A ⟶ B) [epi f] : mono f.unop :=
⟨λ Z g h eq, quiver.hom.op_inj ((cancel_epi f).1 (quiver.hom.unop_inj eq))⟩

instance unop_epi_of_mono {A B : Cᵒᵖ} (f : A ⟶ B) [mono f] : epi f.unop :=
⟨λ Z g h eq, quiver.hom.op_inj ((cancel_mono f).1 (quiver.hom.unop_inj eq))⟩

instance op_mono_of_epi {A B : C} (f : A ⟶ B) [epi f] : mono f.op :=
⟨λ Z g h eq, quiver.hom.unop_inj ((cancel_epi f).1 (quiver.hom.op_inj eq))⟩

instance op_epi_of_mono {A B : C} (f : A ⟶ B) [mono f] : epi f.op :=
⟨λ Z g h eq, quiver.hom.unop_inj ((cancel_mono f).1 (quiver.hom.op_inj eq))⟩

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

lemma left_adjoint_preserves_epi {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)
  {X Y : C} {f : X ⟶ Y} (hf : epi f) : epi (F.map f) :=
begin
  constructor,
  intros Z g h H,
  replace H := congr_arg (adj.hom_equiv X Z) H,
  rwa [adj.hom_equiv_naturality_left, adj.hom_equiv_naturality_left,
    cancel_epi, equiv.apply_eq_iff_eq] at H
end

lemma right_adjoint_preserves_mono {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G)
  {X Y : D} {f : X ⟶ Y} (hf : mono f) : mono (G.map f) :=
begin
  constructor,
  intros Z g h H,
  replace H := congr_arg (adj.hom_equiv Z Y).symm H,
  rwa [adj.hom_equiv_naturality_right_symm, adj.hom_equiv_naturality_right_symm,
    cancel_mono, equiv.apply_eq_iff_eq] at H
end

instance is_equivalence.epi_map {F : C ⥤ D} [is_left_adjoint F] {X Y : C} {f : X ⟶ Y}
  [h : epi f] : epi (F.map f) :=
left_adjoint_preserves_epi (adjunction.of_left_adjoint F) h

instance is_equivalence.mono_map {F : C ⥤ D} [is_right_adjoint F] {X Y : C} {f : X ⟶ Y}
  [h : mono f] : mono (F.map f) :=
right_adjoint_preserves_mono (adjunction.of_right_adjoint F) h

lemma faithful_reflects_epi (F : C ⥤ D) [faithful F] {X Y : C} {f : X ⟶ Y}
  (hf : epi (F.map f)) : epi f :=
⟨λ Z g h H, F.map_injective $
  by rw [←cancel_epi (F.map f), ←F.map_comp, ←F.map_comp, H]⟩

lemma faithful_reflects_mono (F : C ⥤ D) [faithful F] {X Y : C} {f : X ⟶ Y}
  (hf : mono (F.map f)) : mono f :=
⟨λ Z g h H, F.map_injective $
  by rw [←cancel_mono (F.map f), ←F.map_comp, ←F.map_comp, H]⟩
end

/--
A split monomorphism is a morphism `f : X ⟶ Y` admitting a retraction `retraction f : Y ⟶ X`
such that `f ≫ retraction f = 𝟙 X`.

Every split monomorphism is a monomorphism.
-/
class split_mono {X Y : C} (f : X ⟶ Y) :=
(retraction : Y ⟶ X)
(id' : f ≫ retraction = 𝟙 X . obviously)

/--
A split epimorphism is a morphism `f : X ⟶ Y` admitting a section `section_ f : Y ⟶ X`
such that `section_ f ≫ f = 𝟙 Y`.
(Note that `section` is a reserved keyword, so we append an underscore.)

Every split epimorphism is an epimorphism.
-/
class split_epi {X Y : C} (f : X ⟶ Y) :=
(section_ : Y ⟶ X)
(id' : section_ ≫ f = 𝟙 Y . obviously)

/-- The chosen retraction of a split monomorphism. -/
def retraction {X Y : C} (f : X ⟶ Y) [split_mono f] : Y ⟶ X := split_mono.retraction f
@[simp, reassoc]
lemma split_mono.id {X Y : C} (f : X ⟶ Y) [split_mono f] : f ≫ retraction f = 𝟙 X :=
split_mono.id'
/-- The retraction of a split monomorphism is itself a split epimorphism. -/
instance retraction_split_epi {X Y : C} (f : X ⟶ Y) [split_mono f] : split_epi (retraction f) :=
{ section_ := f }

/-- A split mono which is epi is an iso. -/
lemma is_iso_of_epi_of_split_mono {X Y : C} (f : X ⟶ Y) [split_mono f] [epi f] : is_iso f :=
⟨⟨retraction f, ⟨by simp, by simp [← cancel_epi f]⟩⟩⟩

/--
The chosen section of a split epimorphism.
(Note that `section` is a reserved keyword, so we append an underscore.)
-/
def section_ {X Y : C} (f : X ⟶ Y) [split_epi f] : Y ⟶ X := split_epi.section_ f
@[simp, reassoc]
lemma split_epi.id {X Y : C} (f : X ⟶ Y) [split_epi f] : section_ f ≫ f = 𝟙 Y :=
split_epi.id'
/-- The section of a split epimorphism is itself a split monomorphism. -/
instance section_split_mono {X Y : C} (f : X ⟶ Y) [split_epi f] : split_mono (section_ f) :=
{ retraction := f }

/-- A split epi which is mono is an iso. -/
lemma is_iso_of_mono_of_split_epi {X Y : C} (f : X ⟶ Y) [mono f] [split_epi f] : is_iso f :=
⟨⟨section_ f, ⟨by simp [← cancel_mono f], by simp⟩⟩⟩

/-- Every iso is a split mono. -/
@[priority 100]
noncomputable
instance split_mono.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : split_mono f :=
{ retraction := inv f }

/-- Every iso is a split epi. -/
@[priority 100]
noncomputable
instance split_epi.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : split_epi f :=
{ section_ := inv f }

/-- Every split mono is a mono. -/
@[priority 100]
instance split_mono.mono {X Y : C} (f : X ⟶ Y) [split_mono f] : mono f :=
{ right_cancellation := λ Z g h w, begin replace w := w =≫ retraction f, simpa using w, end }

/-- Every split epi is an epi. -/
@[priority 100]
instance split_epi.epi {X Y : C} (f : X ⟶ Y) [split_epi f] : epi f :=
{ left_cancellation := λ Z g h w, begin replace w := section_ f ≫= w, simpa using w, end }

/-- Every split mono whose retraction is mono is an iso. -/
lemma is_iso.of_mono_retraction {X Y : C} {f : X ⟶ Y} [split_mono f] [mono $ retraction f]
  : is_iso f :=
⟨⟨retraction f, ⟨by simp, (cancel_mono_id $ retraction f).mp (by simp)⟩⟩⟩

/-- Every split epi whose section is epi is an iso. -/
lemma is_iso.of_epi_section {X Y : C} {f : X ⟶ Y} [split_epi f] [epi $ section_ f]
  : is_iso f :=
⟨⟨section_ f, ⟨(cancel_epi_id $ section_ f).mp (by simp), by simp⟩⟩⟩

/-- A category where every morphism has a `trunc` retraction is computably a groupoid. -/
-- FIXME this has unnecessarily become noncomputable!
noncomputable
def groupoid.of_trunc_split_mono
  (all_split_mono : ∀ {X Y : C} (f : X ⟶ Y), trunc (split_mono f)) :
  groupoid.{v₁} C :=
begin
  apply groupoid.of_is_iso,
  intros X Y f,
  trunc_cases all_split_mono f,
  trunc_cases all_split_mono (retraction f),
  apply is_iso.of_mono_retraction,
end

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

/-- Split monomorphisms are also absolute monomorphisms. -/
instance {X Y : C} (f : X ⟶ Y) [split_mono f] (F : C ⥤ D) : split_mono (F.map f) :=
{ retraction := F.map (retraction f),
  id' := by { rw [←functor.map_comp, split_mono.id, functor.map_id], } }

/-- Split epimorphisms are also absolute epimorphisms. -/
instance {X Y : C} (f : X ⟶ Y) [split_epi f] (F : C ⥤ D) : split_epi (F.map f) :=
{ section_ := F.map (section_ f),
  id' := by { rw [←functor.map_comp, split_epi.id, functor.map_id], } }
end

end category_theory


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.products.basic

/-!
The hom functor, sending `(X, Y)` to the type `X ⟶ Y`.
-/

universes v u

open opposite
open category_theory

namespace category_theory.functor

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

/-- `functor.hom` is the hom-pairing, sending `(X, Y)` to `X ⟶ Y`, contravariant in `X` and
covariant in `Y`. -/
definition hom : Cᵒᵖ × C ⥤ Type v :=
{ obj       := λ p, unop p.1 ⟶ p.2,
  map       := λ X Y f, λ h, f.1.unop ≫ h ≫ f.2 }

@[simp] lemma hom_obj (X : Cᵒᵖ × C) : (hom C).obj X = (unop X.1 ⟶ X.2) := rfl
@[simp] lemma hom_pairing_map {X Y : Cᵒᵖ × C} (f : X ⟶ Y) :
  (hom C).map f = λ h, f.1.unop ≫ h ≫ f.2 := rfl

end category_theory.functor


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

! This file was ported from Lean 3 source module topology.algebra.valued_field
! leanprover-community/mathlib commit 3e0c4d76b6ebe9dfafb67d16f7286d2731ed6064
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Algebra.Valuation
import Mathbin.Topology.Algebra.WithZeroTopology
import Mathbin.Topology.Algebra.UniformField

/-!
# Valued fields and their completions

In this file we study the topology of a field `K` endowed with a valuation (in our application
to adic spaces, `K` will be the valuation field associated to some valuation on a ring, defined in
valuation.basic).

We already know from valuation.topology that one can build a topology on `K` which
makes it a topological ring.

The first goal is to show `K` is a topological *field*, ie inversion is continuous
at every non-zero element.

The next goal is to prove `K` is a *completable* topological field. This gives us
a completion `hat K` which is a topological field. We also prove that `K` is automatically
separated, so the map from `K` to `hat K` is injective.

Then we extend the valuation given on `K` to a valuation on `hat K`.
-/

open Filter Set

open Topology

section DivisionRing

variable {K : Type _} [DivisionRing K] {Γ₀ : Type _} [LinearOrderedCommGroupWithZero Γ₀]

section ValuationTopologicalDivisionRing

section InversionEstimate

variable (v : Valuation K Γ₀)

-- The following is the main technical lemma ensuring that inversion is continuous
-- in the topology induced by a valuation on a division ring (ie the next instance)
-- and the fact that a valued field is completable
-- [BouAC, VI.5.1 Lemme 1]
theorem Valuation.inversion_estimate {x y : K} {γ : Γ₀ˣ} (y_ne : y ≠ 0)
    (h : v (x - y) < min (γ * (v y * v y)) (v y)) : v (x⁻¹ - y⁻¹) < γ :=
  by
  have hyp1 : v (x - y) < γ * (v y * v y) := lt_of_lt_of_le h (min_le_left _ _)
  have hyp1' : v (x - y) * (v y * v y)⁻¹ < γ := mul_inv_lt_of_lt_mul₀ hyp1
  have hyp2 : v (x - y) < v y := lt_of_lt_of_le h (min_le_right _ _)
  have key : v x = v y := Valuation.map_eq_of_sub_lt v hyp2
  have x_ne : x ≠ 0 := by
    intro h
    apply y_ne
    rw [h, v.map_zero] at key
    exact v.zero_iff.1 key.symm
  have decomp : x⁻¹ - y⁻¹ = x⁻¹ * (y - x) * y⁻¹ := by
    rw [mul_sub_left_distrib, sub_mul, mul_assoc, show y * y⁻¹ = 1 from mul_inv_cancel y_ne,
      show x⁻¹ * x = 1 from inv_mul_cancel x_ne, mul_one, one_mul]
  calc
    v (x⁻¹ - y⁻¹) = v (x⁻¹ * (y - x) * y⁻¹) := by rw [decomp]
    _ = v x⁻¹ * (v <| y - x) * v y⁻¹ := by repeat' rw [Valuation.map_mul]
    _ = (v x)⁻¹ * (v <| y - x) * (v y)⁻¹ := by rw [map_inv₀, map_inv₀]
    _ = (v <| y - x) * (v y * v y)⁻¹ := by rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev]
    _ = (v <| y - x) * (v y * v y)⁻¹ := rfl
    _ = (v <| x - y) * (v y * v y)⁻¹ := by rw [Valuation.map_sub_swap]
    _ < γ := hyp1'

#align valuation.inversion_estimate Valuation.inversion_estimate

end InversionEstimate

open Valued

/-- The topology coming from a valuation on a division ring makes it a topological division ring
    [BouAC, VI.5.1 middle of Proposition 1] -/
instance (priority := 100) Valued.topologicalDivisionRing [Valued K Γ₀] :
    TopologicalDivisionRing K :=
  { (by infer_instance : TopologicalRing K) with
    continuousAt_inv₀ := by
      intro x x_ne s s_in
      cases' valued.mem_nhds.mp s_in with γ hs; clear s_in
      rw [mem_map, Valued.mem_nhds]
      change ∃ γ : Γ₀ˣ, { y : K | (v (y - x) : Γ₀) < γ } ⊆ { x : K | x⁻¹ ∈ s }
      have vx_ne := (Valuation.ne_zero_iff <| v).mpr x_ne
      let γ' := Units.mk0 _ vx_ne
      use min (γ * (γ' * γ')) γ'
      intro y y_in
      apply hs
      simp only [mem_set_of_eq] at y_in
      rw [Units.min_val, Units.val_mul, Units.val_mul] at y_in
      exact Valuation.inversion_estimate _ x_ne y_in }
#align valued.topological_division_ring Valued.topologicalDivisionRing

/-- A valued division ring is separated. -/
instance (priority := 100) ValuedRing.separated [Valued K Γ₀] : SeparatedSpace K :=
  by
  rw [separated_iff_t2]
  apply TopologicalAddGroup.t2Space_of_zero_sep
  intro x x_ne
  refine' ⟨{ k | v k < v x }, _, fun h => lt_irrefl _ h⟩
  rw [Valued.mem_nhds]
  have vx_ne := (Valuation.ne_zero_iff <| v).mpr x_ne
  let γ' := Units.mk0 _ vx_ne
  exact ⟨γ', fun y hy => by simpa using hy⟩
#align valued_ring.separated ValuedRing.separated

section

open WithZeroTopology

open Valued

theorem Valued.continuous_valuation [Valued K Γ₀] : Continuous (v : K → Γ₀) :=
  by
  rw [continuous_iff_continuousAt]
  intro x
  rcases eq_or_ne x 0 with (rfl | h)
  · rw [ContinuousAt, map_zero, WithZeroTopology.tendsto_zero]
    intro γ hγ
    rw [Filter.Eventually, Valued.mem_nhds_zero]
    use Units.mk0 γ hγ, subset.rfl
  · have v_ne : (v x : Γ₀) ≠ 0 := (Valuation.ne_zero_iff _).mpr h
    rw [ContinuousAt, WithZeroTopology.tendsto_of_ne_zero v_ne]
    apply Valued.loc_const v_ne
#align valued.continuous_valuation Valued.continuous_valuation

end

end ValuationTopologicalDivisionRing

end DivisionRing

namespace Valued

open UniformSpace

variable {K : Type _} [Field K] {Γ₀ : Type _} [LinearOrderedCommGroupWithZero Γ₀] [hv : Valued K Γ₀]

include hv

-- mathport name: exprhat
local notation "hat " => Completion

/-- A valued field is completable. -/
instance (priority := 100) completable : CompletableTopField K :=
  { ValuedRing.separated with
    nice := by
      rintro F hF h0
      have : ∃ γ₀ : Γ₀ˣ, ∃ M ∈ F, ∀ x ∈ M, (γ₀ : Γ₀) ≤ v x :=
        by
        rcases filter.inf_eq_bot_iff.mp h0 with ⟨U, U_in, M, M_in, H⟩
        rcases valued.mem_nhds_zero.mp U_in with ⟨γ₀, hU⟩
        exists γ₀, M, M_in
        intro x xM
        apply le_of_not_lt _
        intro hyp
        have : x ∈ U ∩ M := ⟨hU hyp, xM⟩
        rwa [H] at this
      rcases this with ⟨γ₀, M₀, M₀_in, H₀⟩
      rw [Valued.cauchy_iff] at hF⊢
      refine' ⟨hF.1.map _, _⟩
      replace hF := hF.2
      intro γ
      rcases hF (min (γ * γ₀ * γ₀) γ₀) with ⟨M₁, M₁_in, H₁⟩
      clear hF
      use (fun x : K => x⁻¹) '' (M₀ ∩ M₁)
      constructor
      · rw [mem_map]
        apply mem_of_superset (Filter.inter_mem M₀_in M₁_in)
        exact subset_preimage_image _ _
      · rintro _ ⟨x, ⟨x_in₀, x_in₁⟩, rfl⟩ _ ⟨y, ⟨y_in₀, y_in₁⟩, rfl⟩
        simp only [mem_set_of_eq]
        specialize H₁ x x_in₁ y y_in₁
        replace x_in₀ := H₀ x x_in₀
        replace y_in₀ := H₀ y y_in₀
        clear H₀
        apply Valuation.inversion_estimate
        · have : (v x : Γ₀) ≠ 0 := by
            intro h
            rw [h] at x_in₀
            simpa using x_in₀
          exact (Valuation.ne_zero_iff _).mp this
        · refine' lt_of_lt_of_le H₁ _
          rw [Units.min_val]
          apply min_le_min _ x_in₀
          rw [mul_assoc]
          have : ((γ₀ * γ₀ : Γ₀ˣ) : Γ₀) ≤ v x * v x :=
            calc
              ↑γ₀ * ↑γ₀ ≤ ↑γ₀ * v x := mul_le_mul_left' x_in₀ ↑γ₀
              _ ≤ _ := mul_le_mul_right' x_in₀ (v x)

          rw [Units.val_mul]
          exact mul_le_mul_left' this γ }
#align valued.completable Valued.completable

open WithZeroTopology

/-- The extension of the valuation of a valued field to the completion of the field. -/
noncomputable def extension : hat K → Γ₀ :=
  Completion.denseInducing_coe.extend (v : K → Γ₀)
#align valued.extension Valued.extension

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » V') -/
theorem continuous_extension : Continuous (Valued.extension : hat K → Γ₀) :=
  by
  refine' completion.dense_inducing_coe.continuous_extend _
  intro x₀
  rcases eq_or_ne x₀ 0 with (rfl | h)
  · refine' ⟨0, _⟩
    erw [← completion.dense_inducing_coe.to_inducing.nhds_eq_comap]
    exact valued.continuous_valuation.tendsto' 0 0 (map_zero v)
  · have preimage_one : v ⁻¹' {(1 : Γ₀)} ∈ 𝓝 (1 : K) :=
      by
      have : (v (1 : K) : Γ₀) ≠ 0 := by
        rw [Valuation.map_one]
        exact zero_ne_one.symm
      convert Valued.loc_const this
      ext x
      rw [Valuation.map_one, mem_preimage, mem_singleton_iff, mem_set_of_eq]
    obtain ⟨V, V_in, hV⟩ : ∃ V ∈ 𝓝 (1 : hat K), ∀ x : K, (x : hat K) ∈ V → (v x : Γ₀) = 1 := by
      rwa [completion.dense_inducing_coe.nhds_eq_comap, mem_comap] at preimage_one
    have :
      ∃ V' ∈ 𝓝 (1 : hat K), (0 : hat K) ∉ V' ∧ ∀ (x) (_ : x ∈ V') (y) (_ : y ∈ V'), x * y⁻¹ ∈ V :=
      by
      have : tendsto (fun p : hat K × hat K => p.1 * p.2⁻¹) ((𝓝 1).Prod (𝓝 1)) (𝓝 1) :=
        by
        rw [← nhds_prod_eq]
        conv =>
          congr
          skip
          skip
          rw [← one_mul (1 : hat K)]
        refine'
          tendsto.mul continuous_fst.continuous_at (tendsto.comp _ continuous_snd.continuous_at)
        convert continuous_at_inv₀ (zero_ne_one.symm : 1 ≠ (0 : hat K))
        exact inv_one.symm
      rcases tendsto_prod_self_iff.mp this V V_in with ⟨U, U_in, hU⟩
      let hatKstar := ({0}ᶜ : Set <| hat K)
      have : hatKstar ∈ 𝓝 (1 : hat K) := compl_singleton_mem_nhds zero_ne_one.symm
      use U ∩ hatKstar, Filter.inter_mem U_in this
      constructor
      · rintro ⟨h, h'⟩
        rw [mem_compl_singleton_iff] at h'
        exact h' rfl
      · rintro x ⟨hx, _⟩ y ⟨hy, _⟩
        apply hU <;> assumption
    rcases this with ⟨V', V'_in, zeroV', hV'⟩
    have nhds_right : (fun x => x * x₀) '' V' ∈ 𝓝 x₀ :=
      by
      have l : Function.LeftInverse (fun x : hat K => x * x₀⁻¹) fun x : hat K => x * x₀ :=
        by
        intro x
        simp only [mul_assoc, mul_inv_cancel h, mul_one]
      have r : Function.RightInverse (fun x : hat K => x * x₀⁻¹) fun x : hat K => x * x₀ :=
        by
        intro x
        simp only [mul_assoc, inv_mul_cancel h, mul_one]
      have c : Continuous fun x : hat K => x * x₀⁻¹ := continuous_id.mul continuous_const
      rw [image_eq_preimage_of_inverse l r]
      rw [← mul_inv_cancel h] at V'_in
      exact c.continuous_at V'_in
    have : ∃ z₀ : K, ∃ y₀ ∈ V', coe z₀ = y₀ * x₀ ∧ z₀ ≠ 0 :=
      by
      rcases completion.dense_range_coe.mem_nhds nhds_right with ⟨z₀, y₀, y₀_in, H : y₀ * x₀ = z₀⟩
      refine' ⟨z₀, y₀, y₀_in, ⟨H.symm, _⟩⟩
      rintro rfl
      exact mul_ne_zero (ne_of_mem_of_not_mem y₀_in zeroV') h H
    rcases this with ⟨z₀, y₀, y₀_in, hz₀, z₀_ne⟩
    have vz₀_ne : (v z₀ : Γ₀) ≠ 0 := by rwa [Valuation.ne_zero_iff]
    refine' ⟨v z₀, _⟩
    rw [WithZeroTopology.tendsto_of_ne_zero vz₀_ne, eventually_comap]
    filter_upwards [nhds_right]with x x_in a ha
    rcases x_in with ⟨y, y_in, rfl⟩
    have : (v (a * z₀⁻¹) : Γ₀) = 1 := by
      apply hV
      have : ((z₀⁻¹ : K) : hat K) = z₀⁻¹ := map_inv₀ (completion.coe_ring_hom : K →+* hat K) z₀
      rw [completion.coe_mul, this, ha, hz₀, mul_inv, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
        mul_inv_cancel h, mul_one]
      solve_by_elim
    calc
      v a = v (a * z₀⁻¹ * z₀) := by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
      _ = v (a * z₀⁻¹) * v z₀ := (Valuation.map_mul _ _ _)
      _ = v z₀ := by rw [this, one_mul]

#align valued.continuous_extension Valued.continuous_extension

@[simp, norm_cast]
theorem extension_extends (x : K) : extension (x : hat K) = v x :=
  by
  refine' completion.dense_inducing_coe.extend_eq_of_tendsto _
  rw [← completion.dense_inducing_coe.nhds_eq_comap]
  exact valued.continuous_valuation.continuous_at
#align valued.extension_extends Valued.extension_extends

/-- the extension of a valuation on a division ring to its completion. -/
noncomputable def extensionValuation : Valuation (hat K) Γ₀
    where
  toFun := Valued.extension
  map_zero' := by
    rw [← v.map_zero, ← Valued.extension_extends (0 : K)]
    rfl
  map_one' := by
    rw [← completion.coe_one, Valued.extension_extends (1 : K)]
    exact Valuation.map_one _
  map_mul' x y := by
    apply completion.induction_on₂ x y
    · have c1 : Continuous fun x : hat K × hat K => Valued.extension (x.1 * x.2) :=
        valued.continuous_extension.comp (continuous_fst.mul continuous_snd)
      have c2 : Continuous fun x : hat K × hat K => Valued.extension x.1 * Valued.extension x.2 :=
        (valued.continuous_extension.comp continuous_fst).mul
          (valued.continuous_extension.comp continuous_snd)
      exact isClosed_eq c1 c2
    · intro x y
      norm_cast
      exact Valuation.map_mul _ _ _
  map_add_le_max' x y := by
    rw [le_max_iff]
    apply completion.induction_on₂ x y
    · have cont : Continuous (Valued.extension : hat K → Γ₀) := Valued.continuous_extension
      exact
        (isClosed_le (cont.comp continuous_add) <| cont.comp continuous_fst).union
          (isClosed_le (cont.comp continuous_add) <| cont.comp continuous_snd)
    · intro x y
      dsimp
      norm_cast
      rw [← le_max_iff]
      exact v.map_add x y
#align valued.extension_valuation Valued.extensionValuation

-- Bourbaki CA VI §5 no.3 Proposition 5 (d)
theorem closure_coe_completion_v_lt {γ : Γ₀ˣ} :
    closure (coe '' { x : K | v x < (γ : Γ₀) }) = { x : hat K | extensionValuation x < (γ : Γ₀) } :=
  by
  ext x
  let γ₀ := extension_valuation x
  suffices γ₀ ≠ 0 → (x ∈ closure (coe '' { x : K | v x < (γ : Γ₀) }) ↔ γ₀ < (γ : Γ₀))
    by
    cases eq_or_ne γ₀ 0
    · simp only [h, (Valuation.zero_iff _).mp h, mem_set_of_eq, Valuation.map_zero, Units.zero_lt,
        iff_true_iff]
      apply subset_closure
      exact ⟨0, by simpa only [mem_set_of_eq, Valuation.map_zero, Units.zero_lt, true_and_iff] ⟩
    · exact this h
  intro h
  have hγ₀ : extension ⁻¹' {γ₀} ∈ 𝓝 x :=
    continuous_extension.continuous_at.preimage_mem_nhds
      (WithZeroTopology.singleton_mem_nhds_of_ne_zero h)
  rw [mem_closure_iff_nhds']
  refine' ⟨fun hx => _, fun hx s hs => _⟩
  · obtain ⟨⟨-, y, hy₁ : v y < (γ : Γ₀), rfl⟩, hy₂⟩ := hx _ hγ₀
    replace hy₂ : v y = γ₀
    · simpa using hy₂
    rwa [← hy₂]
  · obtain ⟨y, hy₁, hy₂ : ↑y ∈ s⟩ := completion.dense_range_coe.mem_nhds (inter_mem hγ₀ hs)
    replace hy₁ : v y = γ₀
    · simpa using hy₁
    rw [← hy₁] at hx
    exact ⟨⟨y, ⟨y, hx, rfl⟩⟩, hy₂⟩
#align valued.closure_coe_completion_v_lt Valued.closure_coe_completion_v_lt

noncomputable instance valuedCompletion : Valued (hat K) Γ₀
    where
  V := extensionValuation
  is_topological_valuation s :=
    by
    suffices
      has_basis (𝓝 (0 : hat K)) (fun _ => True) fun γ : Γ₀ˣ => { x | extension_valuation x < γ }
      by
      rw [this.mem_iff]
      exact exists_congr fun γ => by simp
    simp_rw [← closure_coe_completion_v_lt]
    exact (has_basis_nhds_zero K Γ₀).hasBasis_of_denseInducing completion.dense_inducing_coe
#align valued.valued_completion Valued.valuedCompletion

@[simp, norm_cast]
theorem valuedCompletion_apply (x : K) : Valued.v (x : hat K) = v x :=
  extension_extends x
#align valued.valued_completion_apply Valued.valuedCompletion_apply

end Valued


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (hp : prime p) (hx : nat.coprime x p) :
  ∃ y : ℕ, x * y = 1 :=
begin
  -- prove the contrapositive
  have h : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from by {
    assume h1 : ¬ (∃ y : ℕ, x * y = 1),
    assume h2 : nat.coprime x p,
    have h3 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h2,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h7 : ∃ y : ℕ, x * y = 1, from by {
      apply nat.coprime.eq_one_of_dvd_one,
      exact h6,
    },
    contradiction,
  },
  -- prove that if x is not a unit, then x is not coprime to p
  have h4 : ¬ (∃ y : ℕ, x * y = 1) → ¬ nat.coprime x p, from
    by {assume h5 : ¬ (∃ y : ℕ, x * y = 1),
    assume h6 : nat.coprime x p,
    have h
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) (h : x.coprime p) : x.units (padic_integers p) :=
begin
  -- we prove the contrapositive
  have h1 : ¬ x.units (padic_integers p) → ¬ x.coprime p, from by {
    assume (h2 : ¬ x.units (padic_integers p)) (h3 : x.coprime p),
    have h4 : x.norm_p p = 1, from by {apply units_iff_norm_eq_one,exact h3},
    have h5 : x.nat_abs < p, from by {apply nat.coprime.not_dvd_iff,exact h3},
    have h6 : x.norm_p p < 1, from by {apply norm_p_le_one,exact h5},
    have h7 : x.norm_p p = 0, from by {apply nat.lt_succ_iff.mp,exact h6},
    have h8 : x = 0, from by {apply norm_p_eq_zero,exact h7},
    have h9 : x ≠ 0, from by {apply nat.coprime.ne_zero,exact h3},
    show false, from by {apply h9,exact h8},
  },
  show x.units (padic_integers p), from by {apply not_not.mp,exact h1 h},
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (x : ℤ_[p]) :=
begin
  assume h1 : coprime p x,
  have h2 : (x : ℤ_[p]) ≠ 0, from by {
    assume h3 : (x : ℤ_[p]) = 0,
    have h4 : x = 0, from by {
      apply nat.eq_zero_of_one_le,
      have h5 : 1 ≤ (x : ℤ_[p]).val, from by {
        apply nat.le_of_lt,
        apply nat.cast_lt.mpr,
        apply nat.lt_succ_self,
      },
      have h6 : (x : ℤ_[p]).val = 0, from by {
        apply nat.eq_zero_of_one_le,
        exact h5,
      },
      rw ← h3 at h6,
      exact h6,
    },
    exact h1.2 h4,
  },
  have h3 : (x : ℤ_[p]).val ≠ 0, from by {
    assume h4 : (x : ℤ_[p]).val = 0,
    have h5 : (x : ℤ_[p]) = 0, from by {
      apply nat.cast_eq_zero,
      exact h4,
    },
    exact h2 h5,
  },
  have h4 : (x : ℤ_[p]).val = 1, from by {
    have h5 : (x : ℤ_[p]).val ≤ 1, from by {
      have h6 : (x : ℤ_[p]).val ≤ (x : ℤ_[p]).val, from by apply nat.le_refl,
      have h7 : (x : ℤ_[p]).val ≤ 1, from by {
        apply nat.le_of_lt,
        apply nat.cast_lt.mpr,
        apply nat.lt_succ_self,
      },
      apply le_trans h6 h7,
    },
    have h6 : (x : ℤ_[p]).val ≠ 0, from by {
      assume h7 : (x : ℤ_[p]).val = 0,
      have h8 : (x : ℤ_[p]) = 0, from by {
        apply nat.cast_eq_zero,
        exact h7,
      },
      exact h2 h8,
    },
    have h7 : (x : ℤ_[p]).val = 1, from by {
      apply nat.eq_of_le_of_ne,
      exact h5,
      exact h6,
    },
    exact h7,
  },
  show is_unit (x : ℤ_[p]), from by {
    apply nat.cast_is_unit,
    exact h4,
  },
end

--OUTPUT 4
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.gcd x p = 1) : (x : ℤ/p) ∈ units (ℤ/p) :=
begin
  -- prove the contrapositive
  have h1 : (x : ℤ/p) ∉ units (ℤ/p) → nat.gcd x p ≠ 1, from assume h1 h2, by {
    -- assume that $x$ is not a unit of $\mathbb{Z}_p$
    assume h1 : (x : ℤ/p) ∉ units (ℤ/p),
    -- assume that $x$ is coprime to $p$
    assume h2 : nat.gcd x p = 1,
    -- any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1
    have h3 : (x : ℤ/p) ∈ units (ℤ/p) ↔ (x : ℤ/p)^2 = 1, from by {
      assume h3 : (x : ℤ/p) ∈ units (ℤ/p),
      have h4 : (x : ℤ/p) * (x : ℤ/p) = 1, from by {
        apply units.ext,
        exact h3,
      },
      show (x : ℤ/p)^2 = 1, from by {
        rw ← sq,
        exact h4,
      },
    },
    -- $\Vert x \Vert \neq 1$
    have h4 : (x : ℤ/p)^2 ≠ 1, from by {
      assume h4 : (x : ℤ/p)^2 = 1,
      show (x : ℤ/p) ∈ units (ℤ/p), from by {
        rw ← h3,
        exact h4,
      },
      exact h1,
    },
    -- since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1
    have h5 : (x : ℤ/p)^2 ≤ 1, from by {
      apply nat.cast_le.2,
      show x^2 ≤ p, from by {
        apply nat.pow_le_pow_of_le_right,
        exact nat.le_of_lt_succ (nat.mod_lt x p),
      },
    },
    -- $\Vert x \Vert < 1$
    have h6 : (x : ℤ/p)^2 < 1, from by {
      apply lt_of_le_of_ne h5 h4,
    },
    -- But this must imply that $p | x$.
    have h7 : p ∣ x, from by {
      apply nat.dvd_of_mod_eq_zero,
      have h8 : x^2 ≡ 0 [p], from by {
        rw ← nat.cast_pow,
        apply nat.mod_eq_zero_of_lt h6,
      },
      have h9 : x^2 ≡ 0 [MOD p], from by {
        exact h8,
      },
      rw ← nat.eq_zero_mod_iff_dvd at h9,
      exact h9,
    },
    show nat.gcd x p ≠ 1, from by {
      rw ← h2,
      apply nat.gcd_eq_one_iff.2,
      exact h7,
    },
  },
  show (x : ℤ/p) ∈ units (ℤ/p), from by {
    apply not_not_intro,
    apply h1,
    exact h,
  },
end

--OUTPUT 5
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd x p = 1) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  -- prove the contrapositive
  have h1 : (x : ℤ_[p]) ∉ units ℤ_[p] → gcd x p ≠ 1, from assume h2 : (x : ℤ_[p]) ∉ units ℤ_[p],
  have h3 : (x : ℤ_[p]) ∉ units ℤ_[p] → (x : ℤ_[p]) ≠ 1, from assume h2 : (x : ℤ_[p]) ∉ units ℤ_[p],
    have h3 : (x : ℤ_[p]) ∉ units ℤ_[p] → (x : ℤ_[p]) ≠ 1, from assume h2 : (x : ℤ_[p]) ∉ units ℤ_[p],
      by {
        assume h3 : (x : ℤ_[p]) = 1,
        have h4 : (x : ℤ_[p]) ∈ units ℤ_[p], from by {
          have h5 : (x : ℤ_[p]) = 1, from by {
            have h5 : (x : ℤ_[p]) = 1, from by {
              have h5 : (x : ℤ_[p]) = 1, from by {
                have h5 : (x : ℤ_[p]) = 1, from by {
                  have h5 : (x : ℤ_[p]) = 1, from by {
                    have h5 : (x : ℤ_[p]) = 1, from by {
                      have h5 : (x : ℤ_[p]) = 1, from by {
                        have h5 : (x : ℤ_[p]) = 1, from by {
                          have h5 : (x : ℤ_[p]) = 1, from by {
                            have h5 : (x : ℤ_[p]) = 1, from by {
                              have h5 : (x : ℤ_[p]) = 1, from by {
                                have h5 : (x : ℤ_[p]) = 1, from by {
                                  have h5 : (x : ℤ_[p]) = 1, from by {
                                    have h5 : (x : ℤ_[p]) = 1, from by {
                                      have h5 : (x : ℤ_[p]) = 1, from by {
                                        have h5 : (x : ℤ_[p]) = 1, from by {
                                          have h5 : (x : ℤ_[p]) = 1, from by {
                                            have h5 : (x : ℤ_[p]) = 1, from by {
                                              have h5 : (x : ℤ_[p]) = 1, from by {
                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                  have h5 : (x : ℤ_[p]) = 1, from by {
                                                    have h5 : (x : ℤ_[p]) = 1, from by {
                                                      have h5 : (x : ℤ_[p]) = 1, from by {
                                                        have h5 : (x : ℤ_[p]) = 1, from by {
                                                          have h5 : (x : ℤ_[p]) = 1, from by {
                                                            have h5 : (x : ℤ_[p]) = 1, from by {
                                                              have h5 : (x : ℤ_[p]) = 1, from by {
                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                  have h5 : (x : ℤ_[p]) = 1, from by {
                                                                    have h5 : (x : ℤ_[p]) = 1, from by {
                                                                      have h5 : (x : ℤ_[p]) = 1, from by {
                                                                        have h5 : (x : ℤ_[p]) = 1, from by {
                                                                          have h5 : (x : ℤ_[p]) = 1, from by {
                                                                            have h5 : (x : ℤ_[p]) = 1, from by {
                                                                              have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {
                                                                                have h5 : (x : ℤ_[p]) = 1, from by {

end --Needs more than 2000 tokens!

--OUTPUT 6
theorem p_adic_units {p : ℕ} (hp : prime p) (x : ℕ) (hx : nat.coprime x p) : is_unit (⟨x,hp⟩ : ℤ_[p]) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  have h1 : ¬ is_unit (⟨x,hp⟩ : ℤ_[p]) → ¬ nat.coprime x p, from
    assume (h2 : ¬ is_unit (⟨x,hp⟩ : ℤ_[p])),
    assume (h3 : nat.coprime x p),
    have h4 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {
      apply nat.coprime.eq_one_of_dvd_one h3,
      show x ∣ 1, from by {rw ← dvd_iff_mod_eq_zero, rw mod_self},
    },
    show false, from h2 h4,
  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
  have h5 : is_unit (⟨x,hp⟩ : ℤ_[p]) ↔ ∥x∥ = 1, from by {
    split,
    assume (h6 : is_unit (⟨x,hp⟩ : ℤ_[p])),
    show ∥x∥ = 1, from by {
      rw norm_eq_one_iff_is_unit,
      exact h6,
    },
    assume (h7 : ∥x∥ = 1),
    show is_unit (⟨x,hp⟩ : ℤ_[p]), from by {
      rw norm_eq_one_iff_is_unit,
      exact h7,
    },
  },
  have h6 : ¬ is_unit (⟨x,hp⟩ : ℤ_[p]) ↔ ∥x∥ ≠ 1, from by {
    split,
    assume (h7 : ¬ is_unit (⟨x,hp⟩ : ℤ_[p])),
    show ∥x∥ ≠ 1, from
      assume (h8 : ∥x∥ = 1),
      show false, from h7 (by {rw h5 at h8, exact h8}),
    assume (h9 : ∥x∥ ≠ 1),
    show ¬ is_unit (⟨x,hp⟩ : ℤ_[p]), from
      assume (h10 : is_unit (⟨x,hp⟩ : ℤ_[p])),
      show false, from h9 (by {rw h5 at h10, exact h10}),
  },
  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have h7 : ∥x∥ < 1, from by {
    rw h6,
    show ∥x∥ ≠ 1, from by {
      assume (h8 : ∥x∥ = 1),
      have h9 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h8, exact h8},
      have h10 : nat.coprime x p, from by {
        rw ← dvd_iff_mod_eq_zero,
        rw ← mod_eq_zero_iff_dvd,
        show x ∣ p, from by {
          rw ← dvd_iff_mod_eq_zero,
          rw ← mod_eq_zero_iff_dvd,
          have h11 : ∥x∥ = 1, from by {rw h5 at h9, exact h9},
          have h12 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h12 at h11,
          rw ← norm_eq_one_iff_is_unit at h11,
          have h13 : ∥x∥^p = 1, from by {rw h11},
          rw ← norm_eq_one_iff_is_unit at h13,
          have h14 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h13, exact h13},
          have h15 : ∥x∥ = 1, from by {rw h5 at h14, exact h14},
          have h16 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h16 at h15,
          rw ← norm_eq_one_iff_is_unit at h15,
          have h17 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h15, exact h15},
          have h18 : ∥x∥ = 1, from by {rw h5 at h17, exact h17},
          have h19 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h19 at h18,
          rw ← norm_eq_one_iff_is_unit at h18,
          have h20 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h18, exact h18},
          have h21 : ∥x∥ = 1, from by {rw h5 at h20, exact h20},
          have h22 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h22 at h21,
          rw ← norm_eq_one_iff_is_unit at h21,
          have h23 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h21, exact h21},
          have h24 : ∥x∥ = 1, from by {rw h5 at h23, exact h23},
          have h25 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h25 at h24,
          rw ← norm_eq_one_iff_is_unit at h24,
          have h26 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h24, exact h24},
          have h27 : ∥x∥ = 1, from by {rw h5 at h26, exact h26},
          have h28 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h28 at h27,
          rw ← norm_eq_one_iff_is_unit at h27,
          have h29 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h27, exact h27},
          have h30 : ∥x∥ = 1, from by {rw h5 at h29, exact h29},
          have h31 : ∥x∥ = ∥x∥^p, from by {rw norm_pow, rw pow_one},
          rw h31 at h30,
          rw ← norm_eq_one_iff_is_unit at h30,
          have h32 : is_unit (⟨x,hp⟩ : ℤ_[p]), from by {rw h5 at h30, exact h30},
          have h33 : ∥x∥ = 1, from by {rw h5 at h32, exact h32},
          have h34 : ∥x
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import category_theory.preadditive.additive_functor
import for_mathlib.category_theory.localization.finite_products
import for_mathlib.category_theory.group_object

noncomputable theory

namespace category_theory

open limits

namespace localization

variables {C D : Type*} [category C] [category D] [preadditive C]
  (L : C ⥤ D) (W : morphism_property C)

variables [morphism_property.contains_identities W]
  [hW : W.stable_under_finite_products]
  [hL : L.is_localization W] [limits.has_finite_products C]

include hL hW

@[protected]
lemma preadditive : preadditive D :=
begin
  haveI : has_finite_products D := localization.has_finite_products L W,
  haveI : ∀ (J : Type) [fintype J], preserves_limits_of_shape (discrete J) L :=
    by { intro J, introI, exact localization.preserves_products_of_shape L W J
      (hW.condition J), },
  let F := preadditive.to_add_comm_group_object C ⋙ L.map_add_comm_group_object,
  have hF : W.is_inverted_by F := λ X Y f hf, begin
    haveI : is_iso ((add_comm_group_object.forget D).map (F.map f)),
    { change is_iso (L.map f),
      exact localization.inverts L W f hf, },
    exact is_iso_of_reflects_iso (F.map f) (add_comm_group_object.forget D),
  end,
  refine add_comm_group_object.preadditive_of (localization.lift F hF L) _,
  haveI : lifting L W (F ⋙ add_comm_group_object.forget D) (𝟭 D) := ⟨iso.refl _⟩,
  exact lifting.uniq L W (F ⋙ add_comm_group_object.forget D)
    (lift F hF L ⋙ add_comm_group_object.forget D) (𝟭 D),
end

lemma additive [preadditive D] : functor.additive L :=
begin
  haveI : has_finite_products D := localization.has_finite_products L W,
  haveI : ∀ (J : Type) [fintype J], preserves_limits_of_shape (discrete J) L :=
    by { intro J, introI, exact localization.preserves_products_of_shape L W J (hW.condition J), },
  exact functor.additive_of_preserves_binary_products L,
end

omit hL

instance : preadditive W.localization := localization.preadditive W.Q W

instance : functor.additive W.Q := localization.additive W.Q W

instance : has_zero_object W.localization :=
⟨⟨terminal _, begin
  split,
  { intro Y,
    refine nonempty.intro ⟨⟨0⟩, λ a, _⟩,
    have eq : 𝟙 (terminal W.localization) = 0 := subsingleton.elim _ _,
    rw [← category.id_comp a, ← category.id_comp default, eq, zero_comp, zero_comp], },
  { exact λ Y, nonempty.intro ⟨⟨0⟩, λ a, subsingleton.elim _ _⟩, },
end⟩⟩

end localization

end category_theory


import tactic
import essai2structures
--import structures

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- sinon ne comprends pas ident*

/- Appelle l'analyse récursive sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def estcepi (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_pi goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_pi expr_t)
    | _ := skip
    end

meta def estcefl (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_arrow goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_arrow expr_t)
    | _ := skip
    end

meta def estceprop (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_prop goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_prop expr_t)
    | _ := skip
    end
end tactic.interactive

example (P Q : Prop) (H: P → Q): ∀ R: Prop, R → R :=
begin
    estcefl,
    intro H1,
    estcefl H1,
    estcefl,
end

open tactic

example (y : ℕ) : true :=
by do e ← to_expr ```(∀ x : ℕ, y = 1), trace e, trace e.is_arrow, trace e.is_pi

example (X Y : Type) (A : set Y) (f : X → Y): ∀ x : X, ∃ y ∈ A, f x = y → y = f x :=
begin
--    interactive.goals_analysis,
    interactive.analyse_buts,
    estcefl f,
    estcefl,
    intros x y,
    estcefl,
end

#check is_prop

example (X Y I : Type) (y : Y) (E : I → set X) : ∀ i : I , ∀ x : E i,  ∀ f : (E i) → Y, f x = y :=
begin
    analyse_buts
end


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.AuxLemmas
import LeanColls.Array
import LeanColls.View
import LeanColls.Classes
import LeanColls.FoldableOps

namespace LeanColls

structure HashMap (κ τ : Type) [Hashable κ] [DecidableEq κ] where
  cap : Nat
  h_cap : 0 < cap ∧ cap < UInt64.size
  backing : COWArray (AList κ τ) cap
  size : Cached (
    View.view backing
    |>.map AList.size
    |> FoldableOps.sum)

namespace HashMap
variable {κ τ : Type} [Hashable κ] [DecidableEq κ]

opaque finishHash (x : UInt64) : UInt64 :=
  let x := x ^^^ (x >>> 30)
  let x := x * 0xbf58476d1ce4e5b9
  let x := x ^^^ (x >>> 27)
  let x := x * 0x94d049bb133111eb
  let x := x ^^^ (x >>> 31)
  x

structure Hashed (κ) [Hashable κ] where
  k : κ
  hashk : Cached (finishHash (hash k))

@[inline]
def mkHashed [Hashable κ] (k : κ) : Hashed κ where
  k := k
  hashk := Cached.cached _

def new (cap : Nat := 16) (h_cap : 0 < cap ∧ cap < UInt64.size := by decide) : HashMap κ τ :=
  ⟨cap, h_cap, COWArray.new [] cap, cached' 0 (by
    clear h_cap
    simp [View.map, View.view, FoldableOps.sum,
      FoldableOps.defaultImpl, Foldable.fold, Foldable'.Correct.fold']
    simp [Size.size, COWArray.new, Indexed.nth, COWArray.get, Array.new, Array.get]
    generalize Range.foldl'' _ _ _ _ = res
    match res with
    | ⟨_,A,hA⟩ =>
    clear res
    simp
    conv =>
      rhs
      arg 2
      intro acc i h
      rw [hA]
      simp
    clear hA A
    induction cap
    case zero => simp
    case succ n ih _ =>
    simp
    apply ih
    simp)⟩

instance : Inhabited (HashMap κ τ) := ⟨HashMap.new⟩

@[inline] private
def calc_idx' (k : κ) (cap : Nat) (h_cap : cap > 0) (h : cap < UInt64.size) : Fin cap :=
  let idx := (hash k) % (UInt64.ofNat cap)
  ⟨idx.toNat, by
    simp [UInt64.mod_def, Fin.mod_def]
    apply Nat.mod_lt_of_lt
    rw [UInt64.val_eq_of_lt h]
    apply Nat.mod_lt
    assumption
    exact UInt64.size_positive
    ⟩

@[inline]
def calc_idx (k : κ) (m : HashMap κ τ) : Fin m.cap :=
  match m with
  | ⟨cap, h_cap, _, _⟩ =>
  calc_idx' k cap h_cap.1 h_cap.2

/- TODO: add Array.getU64 -/
def get? (k : κ) (m : HashMap κ τ) : Option τ :=
  m.backing.get (calc_idx k m)
  |> MapLike.get?.{0,0,0,0} k

@[inline]
private def updateNoRebalance (k : κ) (t : Option τ) (m : HashMap κ τ) : Option τ × HashMap κ τ :=
  let idx := calc_idx k m
  match h : m.backing.get idx |> AList.getAndUpdate k t with
  | (old, newSlot) =>
  let newSize :=
    (if t.isSome then 1 else 0) +
    match old with | none => m.size | some _ => m.size - 1
  ⟨old, m.cap, m.h_cap, m.backing.set idx newSlot, newSize,
  by
    have : newSize = _ + match old, h with | none, h => _ | some _, h => _ := rfl
    rw [this]
    clear this newSize
    have := AList.size_update k t (COWArray.get m.backing idx)
    simp at h
    rw [h.1, h.2] at this
    match old with
    | none =>
      simp at this ⊢
      conv => lhs; rw [View.view_eq_view_canonicalToList]
      conv => rhs; rw [View.view_eq_view_canonicalToList]
      simp
      simp [List.map_set]
      rw [List.sum_set]
      case h_i =>
        simp [idx.isLt]
      simp
      rw [this]
      have := List.get_map_reverse AList.size
        (l := Array.toList m.backing.backing)
        (n := ⟨calc_idx k m, by simp [idx.isLt]⟩)
      rw [this]
      rw [←Nat.sub_add_comm (by apply List.get_le_sum)]
      conv =>
        rhs; arg 1; arg 2
        rw [Nat.add_comm]
      rw [←Nat.add_assoc]
      simp [COWArray.get, ←Array.toList_get]
      rw [Nat.add_comm]
    | some _ =>
      simp at this ⊢
      conv => lhs; rw [View.view_eq_view_canonicalToList]
      conv => rhs; rw [View.view_eq_view_canonicalToList]
      simp
      simp [List.map_set]
      rw [List.sum_set]
      case h_i =>
        simp [idx.isLt]
      simp; stop
      rw [this]
      have := List.get_map_reverse AList.size
        (l := Array.toList m.backing.backing)
        (n := ⟨calc_idx k m, by simp [idx.isLt]⟩)
      rw [this]
      rw [←Nat.sub_add_comm (by apply List.get_le_sum)]
      simp [COWArray.get, ←Array.toList_get]
    ⟩

def rebalance : HashMap κ τ → HashMap κ τ
| ⟨cap, h_cap, backing, size⟩ =>
  if size >= cap then
    new (cap := min (2 * cap) (UInt64.size - 1)) (by
      constructor
      case left =>
        simp [min]
        split
        case inl =>
          rw [(by simp : 0 = 0 * 0)]
          apply Nat.mul_lt_mul'
          decide
          exact h_cap.1
          decide
        case inr =>
          simp
      case right =>
        simp [min]
        split
        case inl h =>
          exact Nat.succ_le_succ h
        case inr h =>
          simp)
    |> Foldable.fold backing (fun acc L =>
      L.foldl (fun acc (k,t) => (acc.updateNoRebalance k (some t)).2) acc)
  else
    ⟨cap, h_cap, backing, size⟩

def set' (k : κ) (t : τ) (m : HashMap κ τ) : Option τ × HashMap κ τ :=
  let (o, h) := m.updateNoRebalance k (some t)
  (o, rebalance h)

def set (k : κ) (t : τ) (m : HashMap κ τ) : HashMap κ τ :=
  rebalance (m.updateNoRebalance k (some t)).2

def fold (m : HashMap κ τ) (f : β → (κ × τ) → β) (acc : β) :=
  Foldable.fold m.backing (fun acc l =>
    Foldable.fold l f acc
  ) acc

instance : Membership κ (HashMap κ τ) where
  mem k m := get? k m |>.isSome

instance : MapLike (HashMap κ τ) κ τ where
  get? := get?
  fold := fold

instance : FoldableOps (HashMap κ τ) (κ × τ) := default

theorem get_rebalance (k : κ) (m : HashMap κ τ)
  : m.rebalance.get? k = m.get? k
  := by
  simp [rebalance]
  split <;> simp
  simp [get?]
  sorry

theorem get_set_eq [Hashable κ] (k : κ) (t : τ) (m : HashMap κ τ)
  : (m.set k t |>.get? k) = some t
  := by
  simp [set, get_rebalance]
  simp [get?, updateNoRebalance, calc_idx, calc_idx']
  simp [COWArray.get, COWArray.set]
  simp [MapLike.get?]

theorem get_set_ne [Hashable κ]
  (k : κ) (t : τ) (k' : κ) (m : HashMap κ τ)
  (h_k : k ≠ k')
  : (m.set k t |>.get? k') = m.get? k'
  := by
  simp [set, get_rebalance]
  simp [get?, updateNoRebalance]
  simp [COWArray.get, COWArray.set]
  simp [calc_idx]
  generalize calc_idx' k _ _ _ = k_idx
  generalize calc_idx' k' _ _ _ = k'_idx
  match h : decide (k_idx = k'_idx) with
  | true =>
    simp at h
    simp [h]
    simp [MapLike.get?, h_k.symm]
  | false =>
    have : k_idx ≠ k'_idx := by
      intro h; cases h; simp at h
    simp [this, Array.copy_def]