import group_theory.subgroup
import group_theory.quotient_group
import group_theory.category
import .category_theory
open category_theory

universe u
structure SES (A B C : Group.{u}) :=
(f : A ⟶ B) (g : B ⟶ C)
(f_inj : function.injective f)
(g_surj : function.surjective g)
(im_f_eq_ker_g : set.range f = is_group_hom.ker g)

lemma SES.is_cc {A B C : Group} (S : SES A B C)
  : ∀ x : A, S.g (S.f x) = 1 :=
  by { intro x, apply iff.mp (is_group_hom.mem_ker S.g),
       rw ← SES.im_f_eq_ker_g, existsi x, refl }

lemma is_group_hom.im_trivial {G H : Group} (φ : G → H) [is_group_hom φ]
  : φ '' is_subgroup.trivial G = is_subgroup.trivial H :=
begin
  simp [set.image, set_of], rw is_group_hom.map_one φ,
  simp [is_subgroup.trivial], funext, apply propext,
  constructor; intro h,
  { rw h, apply or.inl, refl },
  { symmetry, apply or.resolve_right h, exact not_false }
end

lemma SES.inj_of_left_triv {A B C : Group} [subsingleton A] (S : SES A B C)
  : function.injective S.g :=
begin
  apply iff.mpr (is_group_hom.inj_iff_trivial_ker S.g),
  rw ← S.im_f_eq_ker_g,
  transitivity S.f '' is_subgroup.trivial A,
  rw ← set.image_univ, congr, ext, simp, apply subsingleton.elim,
  apply is_group_hom.im_trivial
end

noncomputable
def SES.iso_of_left_triv {A B C : Group} [subsingleton A] (S : SES A B C) : B ≅ C :=
  Group.iso_of_bijective S.g ⟨S.inj_of_left_triv, S.g_surj⟩

lemma SES.surj_of_right_triv {A B C : Group} [subsingleton C] (S : SES A B C)
  : function.surjective S.f :=
begin
  rw [← set.range_iff_surjective, S.im_f_eq_ker_g],
  ext, rw is_group_hom.mem_ker, simp,
  apply subsingleton.elim,
end

noncomputable
def SES.iso_of_right_triv {A B C : Group} [subsingleton C] (S : SES A B C) : A ≅ B :=
  Group.iso_of_bijective S.f ⟨S.f_inj, S.surj_of_right_triv⟩

def SES.transport_iso_mid {A B B' C : Group}
  (S : SES A B C) (iso : B ≅ B') : SES A B' C :=
  { f := S.f ≫ iso.hom, g := iso.inv ≫ S.g,
    f_inj := function.injective_comp (Group.iso_inj iso) S.f_inj,
    g_surj := function.surjective_comp S.g_surj (Group.iso_surj iso.symm),
    im_f_eq_ker_g := by {
      unfold_coes, simp,
      rw set.range_comp,
      have := Group.ker_of_comp_inj S.g iso.inv (Group.iso_inj iso.symm),
      unfold_coes at this, simp at this, rw this,
      have := S.im_f_eq_ker_g, unfold_coes at this, rw this,
      apply congr_fun, apply set.image_eq_preimage_of_inverse,
      apply Group.iso_left_inverse, apply Group.iso_right_inverse } }

def SES.transport_iso_right {A B C C' : Group}
  (S : SES A B C) (iso : C ≅ C') : SES A B C' :=
  { f := S.f, g := S.g ≫ iso.hom, f_inj := S.f_inj,
    g_surj := function.surjective_comp
                (Group.iso_surj iso)
                S.g_surj,
    im_f_eq_ker_g := by {
      unfold_coes, simp,
      transitivity is_group_hom.ker S.g,
      exact S.im_f_eq_ker_g,
      transitivity is_group_hom.ker (@category_struct.comp Group _ _ _ _ S.g iso.hom),
      symmetry, apply Group.ker_of_inj_comp,
      apply Group.iso_inj, refl } }

def SES.self_right (G : Group) : SES 1 G G :=
  { f := ⟨λ x, 1, is_group_hom.mk' (λ x y, eq.symm $ mul_one 1)⟩,
    g := 𝟙 G,
    f_inj := by { intros x y _, apply subsingleton.elim },
    g_surj := λ x, ⟨x, rfl⟩,
    im_f_eq_ker_g := by {
      transitivity is_subgroup.trivial G,
      ext, unfold_coes, simp, constructor; intro h; exact h.symm,
      symmetry, apply iff.mpr (is_group_hom.trivial_ker_iff_eq_one _),
      intros x hx, exact hx } }

def SES.normal_quotient {G : Group} (H : set G) [normal_subgroup H]
  : SES (Group.of H) G (Group.of (quotient_group.quotient H)) := {
    f := subtype_val.group_hom,
    g := ⟨quotient_group.mk, quotient_group.is_group_hom _⟩,
    f_inj := subtype.val_injective,
    g_surj := @quotient.exists_rep _ (quotient_group.left_rel _),
    im_f_eq_ker_g := by {
      unfold_coes, transitivity set.range subtype.val, refl,
      rw [quotient_group.ker_mk, subtype.val_range], refl } }

def is_group_hom.coim {G H : Group} (φ : G → H) [is_group_hom φ]
  := quotient_group.quotient (is_group_hom.ker φ)

instance coim_is_group {G H : Group}
  {φ : G → H} [is_group_hom φ] : group (is_group_hom.coim φ) :=
  quotient_group.group (is_group_hom.ker φ)

def SES.ker_coim {G H : Group} (φ : G → H) [is_group_hom φ]
  : SES (Group.of (is_group_hom.ker φ)) G (Group.of (is_group_hom.coim φ)) :=
  SES.normal_quotient (is_group_hom.ker φ)

def SES.ker_im {G H : Group} (φ : G → H) [is_group_hom φ]
  : SES (Group.of (is_group_hom.ker φ)) G (Group.of (set.range φ)) := {
    f := subtype_val.group_hom,
    g := ⟨set.range_factorization φ, by apply_instance⟩,
    f_inj := subtype.val_injective,
    g_surj := set.surjective_onto_range,
    im_f_eq_ker_g := by {
      unfold_coes,
      transitivity set.range subtype.val, refl,
      transitivity is_group_hom.ker φ,
      rw subtype.range_val, funext,
      funext, simp [set.range_factorization],
      transitivity φ x = 1,
      rw ← is_group_hom.mem_ker φ, refl,
      rw ← @set.mem_def _ _ (is_group_hom.ker _),
      rw is_group_hom.mem_ker, rw subtype.ext, refl } }

lemma SES.left_normal {A B C : Group} (S : SES A B C)
  : normal_subgroup (set.range S.f) :=
  by rw SES.im_f_eq_ker_g; apply is_group_hom.normal_subgroup_ker

noncomputable
def SES.f_rev {A B C : Group} (S : SES A B C) : set.range S.f → A :=
λ y, classical.some y.property

lemma SES.f_rev_spec_r {A B C : Group} (S : SES A B C)
  : ∀ y, S.f (S.f_rev y) = y := λ y, classical.some_spec y.property

lemma SES.f_rev_spec_l {A B C : Group} (S : SES A B C)
  : ∀ x, S.f_rev ⟨S.f x, x, rfl⟩ = x :=
  λ x, S.f_inj (S.f_rev_spec_r ⟨S.f x, x, rfl⟩)

instance SES.f_rev_hom {A B C} {S : SES A B C}
  : is_group_hom (SES.f_rev S) :=
  @is_group_hom.mk _ _ _ _ (SES.f_rev S) $ by {
    constructor, intros,
    cases x with x hx, cases y with y hy,
    cases hx with a ha, cases hy with b hb,
    subst ha, subst hb,
    transitivity SES.f_rev S ⟨S.f (a * b), a*b, rfl⟩,
    congr, apply subtype.eq, simp,
    rw (is_group_hom.to_is_monoid_hom S.f).map_mul,
    apply subtype_val.is_monoid_hom.map_mul,
    repeat { rw SES.f_rev_spec_l } }

noncomputable
def SES.left_iso_range {A B C : Group} (S : SES A B C) : A ≅ Group.of (set.range S.f) := {
  hom := ⟨λ x, ⟨S.f x, set.mem_range_self x⟩,
          is_group_hom.mk' $ λ x y, by {
            apply subtype.eq, rw is_monoid_hom.map_mul subtype.val,
            apply is_monoid_hom.map_mul S.f, exact subtype_val.is_monoid_hom
          }⟩,
  inv := ⟨S.f_rev, by apply_instance⟩,
  hom_inv_id' := subtype.eq (funext S.f_rev_spec_l),
  inv_hom_id' := subtype.eq (funext $ λ x, subtype.eq $ S.f_rev_spec_r x)
}

noncomputable
def SES.pullback {H G K A B : Group} (S : SES H G K) (S' : SES A K B)
  : SES H (Group.of ((S.g) ⁻¹' set.range (S'.f))) A :=
  { f := ⟨λ x, subtype.mk (S.f x)
            $ by { rw set.mem_preimage,
                    have : S.f x ∈ is_group_hom.ker S.g,
                    { rw ← SES.im_f_eq_ker_g, existsi x, refl },
                    rw this.resolve_right not_false,
                    have : is_subgroup (set.range S'.f) := is_group_hom.range_subgroup S'.f,
                    apply is_submonoid.one_mem },
          @is_group_hom.mk _ _ _ _ _ $ by {
      constructor, intros, apply subtype.eq,
      unfold_coes, simp, transitivity S.f x * S.f y,
      apply is_monoid_hom.map_mul, refl }⟩,
    f_inj := by { intros x y h, apply S.f_inj,
                  unfold_coes at h, simp at h, exact h },
    g := ⟨λ x, S'.f_rev ⟨S.g x.val, x.property⟩,
          @is_group_hom.mk _ _ _ _ _ $ by {
            constructor, intros,
            rw ← is_monoid_hom.map_mul S'.f_rev, congr,
            rw is_monoid_hom.map_mul subtype.val,
            unfold_coes, simp,
            apply is_monoid_hom.map_mul,
            apply is_group_hom.to_is_monoid_hom, }⟩,
    g_surj := λ y, by { unfold_coes, simp,
                        cases S.g_surj (S'.f y) with x hx,
                        refine exists.intro (subtype.mk x _) _,
                        apply set.mem_preimage.mpr, existsi y, exact hx.symm,
                        simp, transitivity S'.f_rev ⟨S'.f y, y, rfl⟩,
                        congr, assumption, apply SES.f_rev_spec_l },
    im_f_eq_ker_g := by {
      ext, cases x with x hx,
      transitivity x ∈ set.range S.f,
      { constructor; intro h; cases h with a ha,
        { existsi a, unfold_coes at ha, simp at ha, assumption },
        { have h := hx, rw ← ha at h,
          rw (_ : subtype.mk x hx = subtype.mk (S.f a) h),
          existsi a, refl, apply subtype.eq, exact ha.symm, } },
      rw [SES.im_f_eq_ker_g, is_group_hom.mem_ker, is_group_hom.mem_ker],
      unfold_coes, simp,
      constructor; intro h,
      { transitivity S'.f_rev ⟨1, is_submonoid.one_mem _⟩,
        congr, assumption, apply is_group_hom.map_one S'.f_rev, },
      { have := congr_arg S'.f h,
        rw SES.f_rev_spec_r at this,
        unfold_coes at this, simp at this, rw this,
        apply is_group_hom.map_one, } } }.

lemma ker_comp {A B C : Group} (f : A ⟶ B) (g : B ⟶ C)
  : is_group_hom.ker (g ∘ f) = f⁻¹' (is_group_hom.ker g) :=
by ext; rw [is_group_hom.mem_ker, set.mem_preimage, is_group_hom.mem_ker]

def third_iso {H G K A B : Group}
  (S : SES H G K) (S' : SES A K B)
  : SES (Group.of (S.g ⁻¹' set.range S'.f)) G B := {
    f := subtype_val.group_hom,
    g := S.g ≫ S'.g,
    f_inj := λ _ _ h, subtype.eq h,
    g_surj := function.surjective_comp S'.g_surj S.g_surj,
    im_f_eq_ker_g := by {
      unfold_coes, transitivity is_group_hom.ker (S'.g ∘ S.g),
      rw ker_comp, rw ← S'.im_f_eq_ker_g,
      transitivity set.range subtype.val, refl,
      simp, refl, refl } }

local attribute [instance] classical.prop_decidable
lemma SES.simple {G : Group}
  : simple_group G ↔ (∀ {H K : Group}, nonempty (SES H G K) → subsingleton H ∨ subsingleton K) :=
begin
  constructor; intro h,
  { intros H K S, cases S with S,
    cases h, cases h (is_group_hom.ker S.g) with h h,
    { apply or.inl,
      rw [← S.im_f_eq_ker_g, is_subgroup.eq_trivial_iff] at h,
      constructor, intros, apply S.f_inj,
      transitivity (1 : G), apply h, existsi a, refl,
      symmetry, apply h, existsi b, refl },
    { apply or.inr, constructor, intros,
      cases (S.g_surj a) with a ha, subst ha,
      cases (S.g_surj b) with b hb, subst hb,
      have ha : a ∈ set.univ := set.mem_univ _,
      have hb : b ∈ set.univ := set.mem_univ _,
      rw [← h, is_group_hom.mem_ker] at ha hb,
      transitivity (1 : K), assumption, symmetry, assumption } },
  { constructor, intros,
    cases h ⟨@SES.normal_quotient G N _inst_1⟩ with h h,
    { apply or.inl,
      rw @is_subgroup.eq_trivial_iff _ _ N _inst_1.to_is_subgroup,
      intros, apply @subtype.mk.inj _ N, apply @subsingleton.elim _ h,
      assumption, apply @is_submonoid.one_mem _ _ _ _inst_1.to_is_submonoid },
    { apply or.inr, apply set.eq_univ_of_forall,
      suffices : ∀ x : G, 1⁻¹ * x ∈ N,
      { intro, specialize this x, rw [one_inv, one_mul] at this, exact this },
      cases h with h, intro x,
      specialize h (@quotient_group.mk _ _ N _inst_1.to_is_subgroup 1),
      specialize h (@quotient_group.mk _ _ N _inst_1.to_is_subgroup x),
      dsimp [quotient_group.mk] at h,
      rw quotient.eq' at h_1, assumption, } }
end

def partial_second_iso {H H' G G' K K' : Group.{u}}
  (iso : G ≅ G') (hK' : simple_group K')
  (S : SES H G K) (S' : SES H' G' K')
  (x : H) (x_not_in_H' : ¬ (S'.g (iso.hom (S.f x)) = 1))
  : SES (Group.of $ pullback (S.f ≫ iso.hom) S'.f) H K' := {
    f := @subtype_val.group_hom (Group.of $ H × H') _ _ ≫ @Group.fst H H',
    g := S.f ≫ iso.hom ≫ S'.g,
    f_inj := by { intros x y h,
                  cases x with x hx, cases x with x₁ x₂,
                  cases y with y hy, cases y with y₁ y₂,
                  replace h : x₁ = y₁ := h, apply subtype.eq,
                  simp, apply and.intro h, apply S'.f_inj,
                  exact eq.trans (eq.symm hx) (eq.trans (congr_arg _ h) hy) },
    g_surj := by { intro y, cases S'.g_surj y with a ha,
                   destruct hK', intro hK',
                   replace hK' := λ inst, @hK' (S'.g '' (iso.hom '' set.range S.f)) inst,
                   suffices : normal_subgroup (S'.g '' (iso.hom '' set.range S.f)),
                   have : S'.g '' (iso.hom '' set.range S.f) = set.univ,
                   { apply or.resolve_left (hK' this), intro h,
                     apply x_not_in_H',
                     rw [← is_subgroup.mem_trivial, ← h],
                     apply set.mem_image_of_mem,
                     apply set.mem_image_of_mem,
                     apply set.mem_range_self },
                   rw set.eq_univ_iff_forall at this,
                   simp, cases this y with a ha,
                   cases ha with ha' ha, cases ha' with a ha, cases ha with ha' ha,
                   subst ha, subst ha, cases ha' with a ha', existsi a, rw ha',
                   rw SES.im_f_eq_ker_g, rw ← set.image_comp,
                   apply @surj_im_normal G K' (iso.hom ≫ S'.g),
                   apply function.surjective_comp, exact S'.g_surj, apply Group.iso_surj },
    im_f_eq_ker_g := by {
      unfold_coes, simp,
      transitivity is_group_hom.ker (@category_struct.comp Group _ _ _ _ S.f
                                      (@category_struct.comp Group _ _ _ _ iso.hom S'.g)),
      rw Group.ker_of_comp_inj _ _ S.f_inj,
      dsimp [subtype_val.group_hom, Group.fst],
      rw [set.range_comp, subtype.range_val],
      rw [Group.ker_of_comp_inj _ _ (Group.iso_inj iso), ← S'.im_f_eq_ker_g],
      ext x, rw set.mem_preimage,
      constructor; intro h; cases h with k hk,
      { existsi k.snd, symmetry, rw ← hk.right, exact hk.left },
      { existsi (x, k), constructor, exact hk.symm, refl },
      refl
    }
  }

structure SES.equiv {H H' G G' K K' : Group}
  (iso : G ≅ G') (S : SES H G K) (S' : SES H' G' K') :=
(α : H ≅ H') (β : K ≅ K')
(l_comm : S.f ≫ iso.hom = α.hom ≫ S'.f)
(r_comm : S.g ≫ β.hom = iso.hom ≫ S'.g)

def SES.equiv_symm {H H' G G' K K' : Group}
  (iso : G ≅ G') (S : SES H G K) (S' : SES H' G' K')
  (eqv : SES.equiv iso S S') : SES.equiv iso.symm S' S := {
    α := eqv.α.symm, β := eqv.β.symm,
    l_comm := by {
      refine (_ : @category_struct.comp Group _ _ _ _ S'.f iso.inv
                = @category_struct.comp Group _ _ _ _ eqv.α.inv S.f),
      rw [iso.comp_inv_eq, category.assoc, eqv.l_comm, ← category.assoc,
          eqv.α.inv_hom_id, category.id_comp] },
    r_comm := by {
      refine (_ : @category_struct.comp Group _ _ _ _ S'.g eqv.β.inv
                = @category_struct.comp Group _ _ _ _ iso.inv S.g),
      symmetry,
      rw [iso.inv_comp_eq, ← category.assoc, ← eqv.r_comm, category.assoc,
          eqv.β.hom_inv_id, category.comp_id] }
  }

noncomputable
def SES.map_out_right {H G G' K : Group} (S : SES H G K)
  (φ : G ⟶ G') (hker : ∀ x : H, φ (S.f x) = 1) : K ⟶ G' := {
    val := λ k, φ (function.inv_fun S.g k),
    property := is_group_hom.mk' $ by {
      intros,
      rw [← is_monoid_hom.map_mul φ, is_group_hom.one_iff_ker_inv φ],
      suffices : function.inv_fun S.g (x * y)
               * (function.inv_fun S.g x * function.inv_fun ⇑(S.g) y)⁻¹
               ∈ set.range S.f,
      { cases this with a ha, rw ← ha, apply_assumption },
      rw [SES.im_f_eq_ker_g, is_group_hom.mem_ker, ← is_group_hom.one_iff_ker_inv],
      rw is_monoid_hom.map_mul S.g,
      repeat { rw @function.inv_fun_eq _ _ _ S.g _ (S.g_surj _) }
    }
  }

lemma SES.map_out_right_comm {H G G' K : Group} (S : SES H G K)
  (φ : G ⟶ G') (hker : ∀ x : H, φ (S.f x) = 1)
  : ∀ x : G, SES.map_out_right S φ hker (S.g x) = φ x :=
begin
  intros,
  apply iff.mpr (is_group_hom.one_iff_ker_inv φ (function.inv_fun S.g $ S.g x) x),
  suffices : function.inv_fun S.g (S.g x) * x⁻¹ ∈ set.range S.f,
  { cases this with a ha, rw ← ha, apply_assumption },
  rw [SES.im_f_eq_ker_g, is_group_hom.mem_ker, ← is_group_hom.one_iff_ker_inv],
  apply function.right_inverse_inv_fun, exact S.g_surj
end

noncomputable
def SES.equiv_of_left {H H' G G' K K' : Group}
  (iso : G ≅ G') (S : SES H G K) (S' : SES H' G' K')
  (α : H ≅ H') (l_comm : S.f ≫ iso.hom = α.hom ≫ S'.f)
  : SES.equiv iso S S' :=
  have h1 : ∀ x, (iso.hom ≫ S'.g) (S.f x) = 1,
  by { intro, rw ← iso.eq_comp_inv at l_comm, rw l_comm,
       suffices : S'.g ((iso.hom.val ∘ iso.inv.val) (S'.f (α.hom x))) = 1,
       exact this, have := iso.inv_hom_id,
       simp [(≫), category_struct.id] at this,
       rw this, simp, apply S'.is_cc },
  have h2 : ∀ x, (iso.inv ≫ S.g) (S'.f x) = 1,
  by by { intro, replace l_comm := l_comm.symm,
          rw ← α.eq_inv_comp at l_comm, rw l_comm,
          suffices : S.g ((iso.inv.val ∘ iso.hom.val) (S.f (α.inv x))) = 1,
          exact this, have := iso.hom_inv_id,
          simp [(≫), category_struct.id] at this,
          rw this, simp, apply S.is_cc },
  { α := α, l_comm := l_comm,
    β := {
      hom := SES.map_out_right S (iso.hom ≫ S'.g) h1,
      inv := SES.map_out_right S' (iso.inv ≫ S.g) h2,
      hom_inv_id' := by {
        ext, cases S.g_surj x with x h, subst h, unfold_coes, simp,
        have := SES.map_out_right_comm S (iso.hom ≫ S'.g) h1 x,
        unfold_coes at this, simp [(≫)] at this, rw this, clear this,
        have := SES.map_out_right_comm S' (iso.inv ≫ S.g) h2 (iso.hom.val x),
        unfold_coes at this, simp [(≫)] at this, rw this, clear this,
        congr, transitivity (iso.inv.val ∘ iso.hom.val) x, refl,
        transitivity id x, apply congr_fun, exact subtype.mk.inj iso.hom_inv_id, refl,
      },
      inv_hom_id' := by {
        ext, cases S'.g_surj x with x h, subst h, unfold_coes, simp,
        have := SES.map_out_right_comm S' (iso.inv ≫ S.g) h2 x,
        unfold_coes at this, simp [(≫)] at this, rw this, clear this,
        have := SES.map_out_right_comm S (iso.hom ≫ S'.g) h1 (iso.inv.val x),
        unfold_coes at this, simp [(≫)] at this, rw this, clear this,
        congr, transitivity (iso.hom.val ∘ iso.inv.val) x, refl,
        transitivity id x, apply congr_fun, exact subtype.mk.inj iso.inv_hom_id, refl,
      }
    },
    r_comm := by {
      unfold_coes, simp,
      ext, transitivity SES.map_out_right S (iso.hom ≫ S'.g) h1 (S.g x),
      refl, apply SES.map_out_right_comm,
    }
  }.

noncomputable
def SES.equiv_of_ker_im_match {H H' G G' K K' : Group}
  (iso : G ≅ G') (S : SES H G K) (S' : SES H' G' K')
  (h_l : ∀ x : H, S'.g (iso.hom (S.f x)) = 1)
  (h_r : ∀ x : H', S.g (iso.inv (S'.f x)) = 1)
  : SES.equiv iso S S' :=
    have h1 : iso.hom '' set.range S.f ⊆ is_group_hom.ker S'.g
            ∧ iso.inv '' set.range S'.f ⊆ is_group_hom.ker S.g,
    from by { constructor; intros x hx;
              cases hx with x hx; cases hx with hx hx;
              subst hx; cases hx with x hx; subst hx;
              rw is_group_hom.mem_ker; apply_assumption },
    have h2 : iso.hom '' set.range S.f = set.range S'.f,
    by { rw [← S.im_f_eq_ker_g, ← S'.im_f_eq_ker_g] at h1,
         cases h1 with h h', rw set.image_subset_iff at h',
         rw ← set.image_eq_preimage_of_inverse at h',
         exact funext (λ x, propext ⟨@h x, @h' x⟩),
         apply Group.iso_left_inverse, apply Group.iso_right_inverse },
    have h3  : Group.of ↥(⇑(iso.hom) '' set.range ⇑(S.f)) = Group.of ↥(set.range ⇑(S'.f)),
    by { rw Group.subgroup_eq_of_eq h2, },
    have h4 : ∀ {A B : Group} (h : A = B) (t : A),
          t == (eq.rec (category_theory.iso.refl A) h : A ≅ B).hom.val t,
    by { intros, cases h, refl },
    begin
      refine SES.equiv_of_left iso S S' _ _,
      transitivity,
      exact (S.left_iso_range ≪≫ Group.iso_restrict iso _),
      transitivity, tactic.swap, apply S'.left_iso_range.symm,
      exact eq.rec (category_theory.iso.refl (Group.of ↥(⇑(iso.hom) '' set.range ⇑(S.f)))) h3,
      rw category_theory.iso.trans_assoc,
      ext,
      dsimp [(≪≫)],
      dsimp [SES.left_iso_range],
      dsimp [Group.iso_restrict],
      unfold_coes,
      dsimp [subtype.val],
      rw (_ : S'.f.val = ⇑(S'.f)), tactic.swap, refl,
      rw S'.f_rev_spec_r,
      unfold_coes,
      clear h1, clear h_l, clear h_r,
      generalize h : subtype.mk ((iso.hom).val ((S.f).val x)) _ = t,
      transitivity t.val, { subst h },
      congr, ext, rw h2, apply h4 h3
    end

lemma Group.normal_subgroup_card_lt_of_nontriv_quot
  {H G K : Group} [fintype G] (S : SES H G K) (hK : ¬ subsingleton K)
  : @fintype.card H (fintype.of_injective S.f S.f_inj) < fintype.card G :=
begin
  have : ∃ k : K, k ≠ 1,
  { by_contradiction h, rw not_exists_not at h,
    apply hK, constructor, intros,
    transitivity (1 : K), apply h, symmetry, apply h },
  cases this with k hk, cases S.g_surj k with x hx, subst hx,
  replace hk := mt (iff.mp (is_group_hom.mem_ker S.g)) hk,
  rw [← S.im_f_eq_ker_g] at hk,
  apply @nat.lt_of_le_of_lt _ (@finset.card _ (finset.erase finset.univ x)),
  have h1 : ∀ (y : G), y ∈ finset.erase finset.univ x ↔ y ≠ x,
  { intro, rw [finset.mem_erase, (_ : y ∈ finset.univ ↔ true)],
    apply and_true, rw iff_true, apply finset.mem_univ },
  have h2 : fintype { y : G // y ≠ x } := fintype.subtype _ h1,
  rw ← @fintype.subtype_card _ (λ y, y ≠ x) _ h1,
  apply @nat.le_trans _ (@fintype.card { y : G // y ≠ x } h2),
  apply @fintype.card_le_of_injective H _ (fintype.of_injective S.f S.f_inj) h2
          (λ y, ⟨S.f y, λ h, hk ⟨y, h⟩⟩)
          (λ _ _ hab, S.f_inj (subtype.mk.inj hab)),
  apply nat.le_of_eq, congr,
  rw finset.card_erase_of_mem, dsimp [fintype.card],
  apply nat.pred_lt, refine (_ : ¬ (fintype.card G = 0)),
  rw fintype.card_eq_zero_iff, exact λ h, h 1, apply finset.mem_univ
end

def SES.not_contains_of_simple_quot_and_proper {H H' G G' K K' : Group} (iso : G ≅ G')
  (S : SES H G K) (S' : SES H' G' K')
  (hK : simple_group K) (hK' : ¬ subsingleton K')
  (hnoteqv : SES.equiv iso S S' → false)
  : ∃ x, S'.g (iso.hom (S.f x)) ≠ 1 :=
begin
  have h1 : ¬ ((∀ x, S'.g (iso.hom (S.f x)) = 1)
          ∧ (∀ x, S.g (iso.inv (S'.f x)) = 1)),
  { intro h, apply hnoteqv, cases h,
    apply SES.equiv_of_ker_im_match; assumption },
  rw classical.not_and_distrib at h1, cases h1,
  rw ← classical.not_forall, assumption,
  rw ← classical.not_forall, intro h2, apply h1,
  suffices : iso.inv '' set.range S'.f ⊆ is_group_hom.ker S.g,
  { intro, rw ← is_group_hom.mem_ker S.g,
    exact this ⟨S'.f x, set.mem_range_self x, rfl⟩ },
  destruct hK, intro,
  have : iso.hom '' set.range S.f ⊆ is_group_hom.ker S'.g,
  { intros x hx, cases hx with x' hx,
    rw ← hx.right, cases hx.left with x hx, rw ← hx,
    rw is_group_hom.mem_ker, apply h2 },
  cases @simple (S.g '' (iso.inv '' is_group_hom.ker S'.g))
                (@surj_im_normal _ _ S.g S.g_surj _
                  (surj_im_normal iso.inv (Group.iso_surj iso.symm) _)),
  rw [set.image_subset_iff,
    ← set.image_eq_preimage_of_inverse
      (Group.iso_right_inverse _) (Group.iso_left_inverse _)] at this,
  transitivity S.g ⁻¹' (S.g '' (iso.inv '' is_group_hom.ker S'.g)),
  rw S'.im_f_eq_ker_g, apply set.subset_preimage_image S.g,
  rw h, refl, exfalso, apply hK',
  have : ∀ x : K', x = 1,
  { have h3 := Group.eq_of_im_eq_and_contain_ker _ h _,
    intro x, cases S'.g_surj x with x hx, subst hx,
    rw ← is_group_hom.mem_ker S'.g,
    have h4 : iso.inv x ∈ set.univ := set.mem_univ _,
    rw [← h3, set.mem_image_iff_of_inverse
              (Group.iso_right_inverse _) (Group.iso_left_inverse _),
        Group.iso_right_inverse _] at h4,
    assumption,
    rw [← S.im_f_eq_ker_g,
        set.image_eq_preimage_of_inverse
          (Group.iso_right_inverse _) (Group.iso_left_inverse _)],
    rw ← set.image_subset_iff, assumption },
  constructor, intros, transitivity (1 : K'),
  apply_assumption, symmetry, apply_assumption,
end

noncomputable
def SES.partial_second_iso' {H H' G G' K K' : Group} (iso : G ≅ G')
  (S : SES H G K) (S' : SES H' G' K')
  (hK₁ : simple_group K) (hK₂ : ¬ subsingleton K)
  (hK'₁ : simple_group K') (hK'₂ : ¬ subsingleton K')
  (hnoteqv : SES.equiv iso S S' → false)
  : SES (Group.of (pullback (S.f ≫ iso.hom) S'.f)) H K' :=
begin
  cases classical.subtype_of_exists (SES.not_contains_of_simple_quot_and_proper iso S S' hK₁ hK'₂ hnoteqv),
  apply @partial_second_iso H H' G G' K K' iso hK'₁ S S', assumption,
end


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

import topology.algebra.nonarchimedean.bases
import topology.algebra.uniform_filter_basis
import ring_theory.valuation.basic

/-!
# The topology on a valued ring

In this file, we define the non archimedean topology induced by a valuation on a ring.
The main definition is a `valued` type class which equips a ring with a valuation taking
values in a group with zero (living in the same universe). Other instances are then deduced from
this.
-/

open_locale classical topological_space
open set valuation
noncomputable theory

universe u

/-- A valued ring is a ring that comes equipped with a distinguished valuation.-/
class valued (R : Type u) [ring R] :=
(Γ₀ : Type u)
[grp : linear_ordered_comm_group_with_zero Γ₀]
(v : valuation R Γ₀)

attribute [instance] valued.grp

namespace valued
variables {R : Type*} [ring R] [valued R]

/-- The basis of open subgroups for the topology on a valued ring.-/
lemma subgroups_basis : ring_subgroups_basis (λ γ : (Γ₀ R)ˣ, valued.v.lt_add_subgroup γ) :=
{ inter := begin
    rintros γ₀ γ₁,
    use min γ₀ γ₁,
    simp [valuation.lt_add_subgroup] ; tauto
  end,
  mul := begin
    rintros γ,
    cases exists_square_le γ with γ₀ h,
    use γ₀,
    rintro - ⟨r, s, r_in, s_in, rfl⟩,
    calc v (r*s) = v r * v s : valuation.map_mul _ _ _
             ... < γ₀*γ₀ : mul_lt_mul₀ r_in s_in
             ... ≤ γ : by exact_mod_cast h
  end,
  left_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : v y < 1),
      change v (x * y) < _,
      rw [valuation.map_mul, Hx, zero_mul],
      exact units.zero_lt γ },
    { simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
      use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change v (x * y) < γ,
      rw [valuation.map_mul, Hx, mul_comm],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end,
  right_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : v y < 1),
      change v (y * x) < _,
      rw [valuation.map_mul, Hx, mul_zero],
      exact units.zero_lt γ },
    { use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change v (y * x) < γ,
      rw [valuation.map_mul, Hx],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end }

@[priority 100]
instance : topological_space R := subgroups_basis.topology

lemma mem_nhds {s : set R} {x : R} :
  (s ∈ 𝓝 x) ↔ ∃ γ : (valued.Γ₀ R)ˣ, {y | v (y - x) < γ } ⊆ s :=
by simpa [(subgroups_basis.has_basis_nhds x).mem_iff]

lemma mem_nhds_zero {s : set R} :
  (s ∈ 𝓝 (0 : R)) ↔ ∃ γ : (Γ₀ R)ˣ, {x | v x < (γ : Γ₀ R) } ⊆ s :=
by simp [valued.mem_nhds, sub_zero]

lemma loc_const {x : R} (h : v x ≠ 0) : {y : R | v y = v x} ∈ 𝓝 x :=
begin
  rw valued.mem_nhds,
  rcases units.exists_iff_ne_zero.mpr h with ⟨γ, hx⟩,
  use γ,
  rw hx,
  intros y y_in,
  exact valuation.map_eq_of_sub_lt _ y_in
end

/-- The uniform structure on a valued ring.-/
@[priority 100]
instance uniform_space : uniform_space R := topological_add_group.to_uniform_space R

/-- A valued ring is a uniform additive group.-/
@[priority 100]
instance uniform_add_group : uniform_add_group R := topological_add_group_is_uniform

lemma cauchy_iff {F : filter R} :
  cauchy F ↔ F.ne_bot ∧ ∀ γ : (Γ₀ R)ˣ, ∃ M ∈ F, ∀ x y ∈ M, v (y - x) < γ :=
begin
  rw add_group_filter_basis.cauchy_iff,
  apply and_congr iff.rfl,
  simp_rw subgroups_basis.mem_add_group_filter_basis_iff,
  split,
  { intros h γ,
    exact h _ (subgroups_basis.mem_add_group_filter_basis _) },
  { rintros h - ⟨γ, rfl⟩,
    exact h γ }
end
end valued


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.int.least_greatest
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Order.Basic

/-! # Least upper bound and greatest lower bound properties for integers

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

In this file we prove that a bounded above nonempty set of integers has the greatest element, and a
counterpart of this statement for the least element.

## Main definitions

* `int.least_of_bdd`: if `P : ℤ → Prop` is a decidable predicate, `b` is a lower bound of the set
  `{m | P m}`, and there exists `m : ℤ` such that `P m` (this time, no witness is required), then
  `int.least_of_bdd` returns the least number `m` such that `P m`, together with proofs of `P m` and
  of the minimality. This definition is computable and does not rely on the axiom of choice.
* `int.greatest_of_bdd`: a similar definition with all inequalities reversed.

## Main statements

* `int.exists_least_of_bdd`: if `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is
  bounded below and nonempty, then this set has the least element. This lemma uses classical logic
  to avoid assumption `[decidable_pred P]`. See `int.least_of_bdd` for a constructive counterpart.

* `int.coe_least_of_bdd_eq`: `(int.least_of_bdd b Hb Hinh : ℤ)` does not depend on `b`.

* `int.exists_greatest_of_bdd`, `int.coe_greatest_of_bdd_eq`: versions of the above lemmas with all
  inequalities reversed.

## Tags

integer numbers, least element, greatest element
-/

namespace Int

#print Int.leastOfBdd /-
/-- A computable version of `exists_least_of_bdd`: given a decidable predicate on the
integers, with an explicit lower bound and a proof that it is somewhere true, return
the least value for which the predicate is true. -/
def leastOfBdd {P : ℤ → Prop} [DecidablePred P] (b : ℤ) (Hb : ∀ z : ℤ, P z → b ≤ z)
    (Hinh : ∃ z : ℤ, P z) : { lb : ℤ // P lb ∧ ∀ z : ℤ, P z → lb ≤ z } :=
  have EX : ∃ n : ℕ, P (b + n) :=
    let ⟨elt, Helt⟩ := Hinh
    match elt, le.dest (Hb _ Helt), Helt with
    | _, ⟨n, rfl⟩, Hn => ⟨n, Hn⟩
  ⟨b + (Nat.find EX : ℤ), Nat.find_spec EX, fun z h =>
    match z, le.dest (Hb _ h), h with
    | _, ⟨n, rfl⟩, h => add_le_add_left (Int.ofNat_le.2 <| Nat.find_min' _ h) _⟩
#align int.least_of_bdd Int.leastOfBdd
-/

/- warning: int.exists_least_of_bdd -> Int.exists_least_of_bdd is a dubious translation:
lean 3 declaration is
  forall {P : Int -> Prop}, (Exists.{1} Int (fun (b : Int) => forall (z : Int), (P z) -> (LE.le.{0} Int Int.hasLe b z))) -> (Exists.{1} Int (fun (z : Int) => P z)) -> (Exists.{1} Int (fun (lb : Int) => And (P lb) (forall (z : Int), (P z) -> (LE.le.{0} Int Int.hasLe lb z))))
but is expected to have type
  forall {P : Int -> Prop} [Hbdd : DecidablePred.{1} Int P], (Exists.{1} Int (fun (z : Int) => forall (z_1 : Int), (P z_1) -> (LE.le.{0} Int Int.instLEInt z z_1))) -> (Exists.{1} Int (fun (z : Int) => P z)) -> (Exists.{1} Int (fun (lb : Int) => And (P lb) (forall (z : Int), (P z) -> (LE.le.{0} Int Int.instLEInt lb z))))
Case conversion may be inaccurate. Consider using '#align int.exists_least_of_bdd Int.exists_least_of_bddₓ'. -/
/-- If `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is bounded below and nonempty,
then this set has the least element. This lemma uses classical logic to avoid assumption
`[decidable_pred P]`. See `int.least_of_bdd` for a constructive counterpart. -/
theorem exists_least_of_bdd {P : ℤ → Prop} (Hbdd : ∃ b : ℤ, ∀ z : ℤ, P z → b ≤ z)
    (Hinh : ∃ z : ℤ, P z) : ∃ lb : ℤ, P lb ∧ ∀ z : ℤ, P z → lb ≤ z := by
  classical exact
      let ⟨b, Hb⟩ := Hbdd
      let ⟨lb, H⟩ := least_of_bdd b Hb Hinh
      ⟨lb, H⟩
#align int.exists_least_of_bdd Int.exists_least_of_bdd

#print Int.coe_leastOfBdd_eq /-
theorem coe_leastOfBdd_eq {P : ℤ → Prop} [DecidablePred P] {b b' : ℤ} (Hb : ∀ z : ℤ, P z → b ≤ z)
    (Hb' : ∀ z : ℤ, P z → b' ≤ z) (Hinh : ∃ z : ℤ, P z) :
    (leastOfBdd b Hb Hinh : ℤ) = leastOfBdd b' Hb' Hinh :=
  by
  rcases least_of_bdd b Hb Hinh with ⟨n, hn, h2n⟩
  rcases least_of_bdd b' Hb' Hinh with ⟨n', hn', h2n'⟩
  exact le_antisymm (h2n _ hn') (h2n' _ hn)
#align int.coe_least_of_bdd_eq Int.coe_leastOfBdd_eq
-/

#print Int.greatestOfBdd /-
/-- A computable version of `exists_greatest_of_bdd`: given a decidable predicate on the
integers, with an explicit upper bound and a proof that it is somewhere true, return
the greatest value for which the predicate is true. -/
def greatestOfBdd {P : ℤ → Prop} [DecidablePred P] (b : ℤ) (Hb : ∀ z : ℤ, P z → z ≤ b)
    (Hinh : ∃ z : ℤ, P z) : { ub : ℤ // P ub ∧ ∀ z : ℤ, P z → z ≤ ub } :=
  have Hbdd' : ∀ z : ℤ, P (-z) → -b ≤ z := fun z h => neg_le.1 (Hb _ h)
  have Hinh' : ∃ z : ℤ, P (-z) :=
    let ⟨elt, Helt⟩ := Hinh
    ⟨-elt, by rw [neg_neg] <;> exact Helt⟩
  let ⟨lb, Plb, al⟩ := leastOfBdd (-b) Hbdd' Hinh'
  ⟨-lb, Plb, fun z h => le_neg.1 <| al _ <| by rwa [neg_neg]⟩
#align int.greatest_of_bdd Int.greatestOfBdd
-/

/- warning: int.exists_greatest_of_bdd -> Int.exists_greatest_of_bdd is a dubious translation:
lean 3 declaration is
  forall {P : Int -> Prop}, (Exists.{1} Int (fun (b : Int) => forall (z : Int), (P z) -> (LE.le.{0} Int Int.hasLe z b))) -> (Exists.{1} Int (fun (z : Int) => P z)) -> (Exists.{1} Int (fun (ub : Int) => And (P ub) (forall (z : Int), (P z) -> (LE.le.{0} Int Int.hasLe z ub))))
but is expected to have type
  forall {P : Int -> Prop} [Hbdd : DecidablePred.{1} Int P], (Exists.{1} Int (fun (z : Int) => forall (z_1 : Int), (P z_1) -> (LE.le.{0} Int Int.instLEInt z_1 z))) -> (Exists.{1} Int (fun (z : Int) => P z)) -> (Exists.{1} Int (fun (ub : Int) => And (P ub) (forall (z : Int), (P z) -> (LE.le.{0} Int Int.instLEInt z ub))))
Case conversion may be inaccurate. Consider using '#align int.exists_greatest_of_bdd Int.exists_greatest_of_bddₓ'. -/
/-- If `P : ℤ → Prop` is a predicate such that the set `{m : P m}` is bounded above and nonempty,
then this set has the greatest element. This lemma uses classical logic to avoid assumption
`[decidable_pred P]`. See `int.greatest_of_bdd` for a constructive counterpart. -/
theorem exists_greatest_of_bdd {P : ℤ → Prop} (Hbdd : ∃ b : ℤ, ∀ z : ℤ, P z → z ≤ b)
    (Hinh : ∃ z : ℤ, P z) : ∃ ub : ℤ, P ub ∧ ∀ z : ℤ, P z → z ≤ ub := by
  classical exact
      let ⟨b, Hb⟩ := Hbdd
      let ⟨lb, H⟩ := greatest_of_bdd b Hb Hinh
      ⟨lb, H⟩
#align int.exists_greatest_of_bdd Int.exists_greatest_of_bdd

#print Int.coe_greatestOfBdd_eq /-
theorem coe_greatestOfBdd_eq {P : ℤ → Prop} [DecidablePred P] {b b' : ℤ} (Hb : ∀ z : ℤ, P z → z ≤ b)
    (Hb' : ∀ z : ℤ, P z → z ≤ b') (Hinh : ∃ z : ℤ, P z) :
    (greatestOfBdd b Hb Hinh : ℤ) = greatestOfBdd b' Hb' Hinh :=
  by
  rcases greatest_of_bdd b Hb Hinh with ⟨n, hn, h2n⟩
  rcases greatest_of_bdd b' Hb' Hinh with ⟨n', hn', h2n'⟩
  exact le_antisymm (h2n' _ hn) (h2n _ hn')
#align int.coe_greatest_of_bdd_eq Int.coe_greatestOfBdd_eq
-/

end Int


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si
--    s ⊆ t
-- entonces
--    s ∩ u ⊆ t ∩ u
-- ----------------------------------------------------------------------

import tactic

variable {α : Type*}
variables (s t u : set α)

open set

-- 1ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
begin
  rw subset_def,
  rw inter_def,
  rw inter_def,
  dsimp,
  rw subset_def at h,
  rintros x ⟨xs, xu⟩,
  split,
  { exact h x xs },
  { exact xu },
end

-- Prueba
-- ======

/-
α : Type u_1,
s t u : set α,
h : s ⊆ t
⊢ s ∩ u ⊆ t ∩ u
  >> rw subset_def,
⊢ ∀ (x : α), x ∈ s ∩ u → x ∈ t ∩ u
  >> rw inter_def,
⊢ ∀ (x : α), x ∈ {a : α | a ∈ s ∧ a ∈ u} → x ∈ t ∩ u
  >> rw inter_def,
⊢ ∀ (x : α), x ∈ {a : α | a ∈ s ∧ a ∈ u} → x ∈ {a : α | a ∈ t ∧ a ∈ u}
  >> dsimp,
⊢ ∀ (x : α), x ∈ s ∧ x ∈ u → x ∈ t ∧ x ∈ u
  >> rw subset_def at h,
h : ∀ (x : α), x ∈ s → x ∈ t
⊢ ∀ (x : α), x ∈ s ∧ x ∈ u → x ∈ t ∧ x ∈ u
  >> rintros x ⟨xs, xu⟩,
x : α,
xs : x ∈ s,
xu : x ∈ u
⊢ x ∈ t ∧ x ∈ u
  >> split,
| ⊢ x ∈ t
|   >> { exact h x xs },
⊢ x ∈ u
  >> { exact xu },
no goals
-/

-- 2ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
begin
  rw [subset_def, inter_def, inter_def],
  dsimp,
  rw subset_def at h,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end

-- Prueba
-- ======

/-
α : Type u_1,
s t u : set α,
h : s ⊆ t
⊢ s ∩ u ⊆ t ∩ u  >> rw [subset_def, inter_def, inter_def],
  >> dsimp,
⊢ ∀ (x : α), x ∈ s ∧ x ∈ u → x ∈ t ∧ x ∈ u
  >> rw subset_def at h,
h : ∀ (x : α), x ∈ s → x ∈ t
⊢ ∀ (x : α), x ∈ s ∧ x ∈ u → x ∈ t ∧ x ∈ u
  >> rintros x ⟨xs, xu⟩,
x : α,
xs : x ∈ s,
xu : x ∈ u
⊢ x ∈ t ∧ x ∈ u
  >> exact ⟨h _ xs, xu⟩,
no goals
-/

-- 3ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
begin
  simp only [subset_def, mem_inter_eq] at *,
  rintros x ⟨xs, xu⟩,
  exact ⟨h _ xs, xu⟩,
end

-- Prueba
-- ======

/-
α : Type u_1,
s t u : set α,
h : s ⊆ t
⊢ s ∩ u ⊆ t ∩ u
  >> simp only [subset_def, mem_inter_eq] at *,
h : ∀ (x : α), x ∈ s → x ∈ t
⊢ ∀ (x : α), x ∈ s ∧ x ∈ u → x ∈ t ∧ x ∈ u
  >> rintros x ⟨xs, xu⟩,
x : α,
xs : x ∈ s,
xu : x ∈ u
⊢ x ∈ t ∧ x ∈ u
  >> exact ⟨h _ xs, xu⟩,
no goals
-/

-- 4ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
by finish [subset_def, mem_inter_eq]

-- 5ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
begin
  intros x xsu,
  exact ⟨h xsu.1, xsu.2⟩,
end

-- Prueba
-- ======

/-
α : Type u_1,
s t u : set α,
h : s ⊆ t
⊢ s ∩ u ⊆ t ∩ u
  >> intros x xsu,
x : α,
xsu : x ∈ s ∩ u
⊢ x ∈ t ∩ u
  >> exact ⟨h xsu.1, xsu.2⟩,
no goals
-/

-- Comentario: La táctica *intro* aplica una *reducción definicional*
-- expandiendo las definiciones.

-- 6ª demostración
-- ===============

example (h : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
by exact λ x ⟨xs, xu⟩, ⟨h xs, xu⟩

-- 7ª demostración
-- ===============

lemma monotonia
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
λ x ⟨xs, xu⟩, ⟨h xs, xu⟩

-- 8ª demostración
-- ===============

example
  (h : s ⊆ t)
  : s ∩ u ⊆ t ∩ u :=
inter_subset_inter_left u h

-- Comentario: Se han usado los lemas
-- + inter_def : s ∩ t = {a : α | a ∈ s ∧ a ∈ t}
-- + inter_subset_inter_left : s ⊆ t → s ∩ u ⊆ t ∩ u
-- + mem_inter_eq x s t : x ∈ s ∩ t = (x ∈ s ∧ x ∈ t)
-- + subset_def : s ⊆ t = ∀ (x : α), x ∈ s → x ∈ t

-- Comprobación:
variable (x : α)
-- #check @subset_def _ s t
-- #check @inter_def _ s t
-- #check @mem_inter_eq _ x s t
-- #check @inter_subset_inter_left _ s t u


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

import topology.algebra.nonarchimedean.bases
import topology.algebra.uniform_filter_basis
import ring_theory.valuation.basic

/-!
# The topology on a valued ring

In this file, we define the non archimedean topology induced by a valuation on a ring.
The main definition is a `valued` type class which equips a ring with a valuation taking
values in a group with zero (living in the same universe). Other instances are then deduced from
this.
-/

open_locale classical topological_space
open set valuation
noncomputable theory

universe u

/-- A valued ring is a ring that comes equipped with a distinguished valuation.-/
class valued (R : Type u) [ring R] :=
(Γ₀ : Type u)
[grp : linear_ordered_comm_group_with_zero Γ₀]
(v : valuation R Γ₀)

attribute [instance] valued.grp

namespace valued
variables {R : Type*} [ring R] [valued R]

/-- The basis of open subgroups for the topology on a valued ring.-/
lemma subgroups_basis : ring_subgroups_basis (λ γ : units (Γ₀ R), valued.v.lt_add_subgroup γ) :=
{ inter := begin
    rintros γ₀ γ₁,
    use min γ₀ γ₁,
    simp [valuation.lt_add_subgroup] ; tauto
  end,
  mul := begin
    rintros γ,
    cases exists_square_le γ with γ₀ h,
    use γ₀,
    rintro - ⟨r, s, r_in, s_in, rfl⟩,
    calc v (r*s) = v r * v s : valuation.map_mul _ _ _
             ... < γ₀*γ₀ : mul_lt_mul₀ r_in s_in
             ... ≤ γ : by exact_mod_cast h
  end,
  left_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : v y < 1),
      change v (x * y) < _,
      rw [valuation.map_mul, Hx, zero_mul],
      exact units.zero_lt γ },
    { simp only [image_subset_iff, set_of_subset_set_of, preimage_set_of_eq, valuation.map_mul],
      use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change v (x * y) < γ,
      rw [valuation.map_mul, Hx, mul_comm],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end,
  right_mul := begin
    rintros x γ,
    rcases group_with_zero.eq_zero_or_unit (v x) with Hx | ⟨γx, Hx⟩,
    { use 1,
      rintros y (y_in : v y < 1),
      change v (y * x) < _,
      rw [valuation.map_mul, Hx, mul_zero],
      exact units.zero_lt γ },
    { use γx⁻¹*γ,
      rintros y (vy_lt : v y < ↑(γx⁻¹ * γ)),
      change v (y * x) < γ,
      rw [valuation.map_mul, Hx],
      rw [units.coe_mul, mul_comm] at vy_lt,
      simpa using mul_inv_lt_of_lt_mul₀ vy_lt }
  end }

@[priority 100]
instance : topological_space R := subgroups_basis.topology

lemma mem_nhds {s : set R} {x : R} :
  (s ∈ 𝓝 x) ↔ ∃ γ : units (valued.Γ₀ R), {y | v (y - x) < γ } ⊆ s :=
by simpa [(subgroups_basis.has_basis_nhds x).mem_iff]

lemma mem_nhds_zero {s : set R} :
  (s ∈ 𝓝 (0 : R)) ↔ ∃ γ : units (Γ₀ R), {x | v x < (γ : Γ₀ R) } ⊆ s :=
by simp [valued.mem_nhds, sub_zero]

lemma loc_const {x : R} (h : v x ≠ 0) : {y : R | v y = v x} ∈ 𝓝 x :=
begin
  rw valued.mem_nhds,
  rcases units.exists_iff_ne_zero.mpr h with ⟨γ, hx⟩,
  use γ,
  rw hx,
  intros y y_in,
  exact valuation.map_eq_of_sub_lt _ y_in
end

/-- The uniform structure on a valued ring.-/
@[priority 100]
instance uniform_space : uniform_space R := topological_add_group.to_uniform_space R

/-- A valued ring is a uniform additive group.-/
@[priority 100]
instance uniform_add_group : uniform_add_group R := topological_add_group_is_uniform

lemma cauchy_iff {F : filter R} :
  cauchy F ↔ F.ne_bot ∧ ∀ γ : units (Γ₀ R), ∃ M ∈ F, ∀ x y, x ∈ M → y ∈ M → v (y - x) < γ :=
begin
  rw add_group_filter_basis.cauchy_iff,
  apply and_congr iff.rfl,
  simp_rw subgroups_basis.mem_add_group_filter_basis_iff,
  split,
  { intros h γ,
    exact h _ (subgroups_basis.mem_add_group_filter_basis _) },
  { rintros h - ⟨γ, rfl⟩,
    exact h γ }
end
end valued


/-
Copyright (c) 2020 Yury Kudryashov, Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Anne Baanen
-/
import data.fintype.card
import data.fintype.fin
import logic.equiv.fin

/-!
# Big operators and `fin`

Some results about products and sums over the type `fin`.

The most important results are the induction formulas `fin.prod_univ_cast_succ`
and `fin.prod_univ_succ`, and the formula `fin.prod_const` for the product of a
constant function. These results have variants for sums instead of products.

-/

open_locale big_operators

open finset

variables {α : Type*} {β : Type*}

namespace finset

@[to_additive]
theorem prod_range [comm_monoid β] {n : ℕ} (f : ℕ → β) :
  ∏ i in finset.range n, f i = ∏ i : fin n, f i :=
prod_bij'
  (λ k w, ⟨k, mem_range.mp w⟩)
  (λ a ha, mem_univ _)
  (λ a ha, congr_arg _ (fin.coe_mk _).symm)
  (λ a m, a)
  (λ a m, mem_range.mpr a.prop)
  (λ a ha, fin.coe_mk _)
  (λ a ha, fin.eta _ _)

end finset

namespace fin

@[to_additive]
theorem prod_univ_def [comm_monoid β] {n : ℕ} (f : fin n → β) :
  ∏ i, f i = ((list.fin_range n).map f).prod :=
by simp [univ_def, finset.fin_range]

@[to_additive]
theorem prod_of_fn [comm_monoid β] {n : ℕ} (f : fin n → β) :
  (list.of_fn f).prod = ∏ i, f i :=
by rw [list.of_fn_eq_map, prod_univ_def]

/-- A product of a function `f : fin 0 → β` is `1` because `fin 0` is empty -/
@[to_additive "A sum of a function `f : fin 0 → β` is `0` because `fin 0` is empty"]
theorem prod_univ_zero [comm_monoid β] (f : fin 0 → β) : ∏ i, f i = 1 := rfl

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f x`, for some `x : fin (n + 1)` times the remaining product -/
@[to_additive
/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f x`, for some `x : fin (n + 1)` plus the remaining product -/]

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f 0` plus the remaining product -/
@[to_additive
/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f 0` plus the remaining product -/]
theorem prod_univ_succ [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
  ∏ i, f i = f 0 * ∏ i : fin n, f i.succ :=
prod_univ_succ_above f 0

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f (fin.last n)` plus the remaining product -/
@[to_additive
/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f (fin.last n)` plus the remaining sum -/]
theorem prod_univ_cast_succ [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) :
  ∏ i, f i = (∏ i : fin n, f i.cast_succ) * f (last n) :=
by simpa [mul_comm] using prod_univ_succ_above f (last n)

@[to_additive] lemma prod_cons [comm_monoid β] {n : ℕ} (x : β) (f : fin n → β) :
  ∏ i : fin n.succ, (cons x f : fin n.succ → β) i = x * ∏ i : fin n, f i :=
by simp_rw [prod_univ_succ, cons_zero, cons_succ]

@[to_additive sum_univ_one] theorem prod_univ_one [comm_monoid β] (f : fin 1 → β) :
  ∏ i, f i = f 0 :=
by simp

@[to_additive] theorem prod_univ_two [comm_monoid β] (f : fin 2 → β) :
  ∏ i, f i = f 0 * f 1 :=
by simp [prod_univ_succ]

lemma sum_pow_mul_eq_add_pow {n : ℕ} {R : Type*} [comm_semiring R] (a b : R) :
  ∑ s : finset (fin n), a ^ s.card * b ^ (n - s.card) = (a + b) ^ n :=
by simpa using fintype.sum_pow_mul_eq_add_pow (fin n) a b

lemma prod_const [comm_monoid α] (n : ℕ) (x : α) : ∏ i : fin n, x = x ^ n := by simp

lemma sum_const [add_comm_monoid α] (n : ℕ) (x : α) : ∑ i : fin n, x = n • x := by simp

@[to_additive] lemma prod_Ioi_zero {M : Type*} [comm_monoid M] {n : ℕ} {v : fin n.succ → M} :
  ∏ i in Ioi 0, v i = ∏ j : fin n, v j.succ :=
by rw [Ioi_zero_eq_map, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

@[to_additive]
lemma prod_Ioi_succ {M : Type*} [comm_monoid M] {n : ℕ} (i : fin n) (v : fin n.succ → M) :
  ∏ j in Ioi i.succ, v j = ∏ j in Ioi i, v j.succ :=
by rw [Ioi_succ, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

@[to_additive]
lemma prod_congr' {M : Type*} [comm_monoid M] {a b : ℕ} (f : fin b → M) (h : a = b) :
  ∏ (i : fin a), f (cast h i) = ∏ (i : fin b), f i :=
by { subst h, congr, ext, congr, ext, rw coe_cast, }

@[to_additive]
lemma prod_univ_add {M : Type*} [comm_monoid M] {a b : ℕ} (f : fin (a+b) → M) :
  ∏ (i : fin (a+b)), f i =
  (∏ (i : fin a), f (cast_add b i)) * ∏ (i : fin b), f (nat_add a i) :=
begin
  rw fintype.prod_equiv fin_sum_fin_equiv.symm f (λ i, f (fin_sum_fin_equiv.to_fun i)), swap,
  { intro x,
    simp only [equiv.to_fun_as_coe, equiv.apply_symm_apply], },
  apply prod_on_sum,
end

@[to_additive]
lemma prod_trunc {M : Type*} [comm_monoid M] {a b : ℕ} (f : fin (a+b) → M)
  (hf : ∀ (j : fin b), f (nat_add a j) = 1) :
  ∏ (i : fin (a+b)), f i =
  ∏ (i : fin a), f (cast_le (nat.le.intro rfl) i) :=
by simpa only [prod_univ_add, fintype.prod_eq_one _ hf, mul_one]

end fin

namespace list

@[to_additive]
lemma prod_take_of_fn [comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) :
  ((of_fn f).take i).prod = ∏ j in finset.univ.filter (λ (j : fin n), j.val < i), f j :=
begin
  have A : ∀ (j : fin n), ¬ ((j : ℕ) < 0) := λ j, not_lt_bot,
  induction i with i IH, { simp [A] },
  by_cases h : i < n,
  { have : i < length (of_fn f), by rwa [length_of_fn f],
    rw prod_take_succ _ _ this,
    have A : ((finset.univ : finset (fin n)).filter (λ j, j.val < i + 1))
      = ((finset.univ : finset (fin n)).filter (λ j, j.val < i)) ∪ {(⟨i, h⟩ : fin n)},
        by { ext j, simp [nat.lt_succ_iff_lt_or_eq, fin.ext_iff, - add_comm] },
    have B : _root_.disjoint (finset.filter (λ (j : fin n), j.val < i) finset.univ)
      (singleton (⟨i, h⟩ : fin n)), by simp,
    rw [A, finset.prod_union B, IH],
    simp },
  { have A : (of_fn f).take i = (of_fn f).take i.succ,
    { rw ← length_of_fn f at h,
      have : length (of_fn f) ≤ i := not_lt.mp h,
      rw [take_all_of_le this, take_all_of_le (le_trans this (nat.le_succ _))] },
    have B : ∀ (j : fin n), ((j : ℕ) < i.succ) = ((j : ℕ) < i),
    { assume j,
      have : (j : ℕ) < i := lt_of_lt_of_le j.2 (not_lt.mp h),
      simp [this, lt_trans this (nat.lt_succ_self _)] },
    simp [← A, B, IH] }
end

@[to_additive]
lemma prod_of_fn [comm_monoid α] {n : ℕ} {f : fin n → α} :
  (of_fn f).prod = ∏ i, f i :=
begin
  convert prod_take_of_fn f n,
  { rw [take_all_of_le (le_of_eq (length_of_fn f))] },
  { have : ∀ (j : fin n), (j : ℕ) < n := λ j, j.is_lt,
    simp [this] }
end

lemma alternating_sum_eq_finset_sum {G : Type*} [add_comm_group G] :
  ∀ (L : list G), alternating_sum L = ∑ i : fin L.length, (-1 : ℤ) ^ (i : ℕ) • L.nth_le i i.is_lt
| [] := by { rw [alternating_sum, finset.sum_eq_zero], rintro ⟨i, ⟨⟩⟩ }
| (g :: []) := by simp
| (g :: h :: L) :=
calc g + -h + L.alternating_sum
    = g + -h + ∑ i : fin L.length, (-1 : ℤ) ^ (i : ℕ) • L.nth_le i i.2 :
      congr_arg _ (alternating_sum_eq_finset_sum _)
... = ∑ i : fin (L.length + 2), (-1 : ℤ) ^ (i : ℕ) • list.nth_le (g :: h :: L) i _ :
begin
  rw [fin.sum_univ_succ, fin.sum_univ_succ, add_assoc],
  unfold_coes,
  simp [nat.succ_eq_add_one, pow_add],
  refl,
end

@[to_additive]
lemma alternating_prod_eq_finset_prod {G : Type*} [comm_group G] :
  ∀ (L : list G), alternating_prod L = ∏ i : fin L.length, (L.nth_le i i.2) ^ ((-1 : ℤ) ^ (i : ℕ))
| [] := by { rw [alternating_prod, finset.prod_eq_one], rintro ⟨i, ⟨⟩⟩ }
| (g :: []) :=
begin
  show g = ∏ i : fin 1, [g].nth_le i i.2 ^ (-1 : ℤ) ^ (i : ℕ),
  rw [fin.prod_univ_succ], simp,
end
| (g :: h :: L) :=
calc g * h⁻¹ * L.alternating_prod
    = g * h⁻¹ * ∏ i : fin L.length, L.nth_le i i.2 ^ (-1 : ℤ) ^ (i : ℕ) :
      congr_arg _ (alternating_prod_eq_finset_prod _)
... = ∏ i : fin (L.length + 2), list.nth_le (g :: h :: L) i _ ^ (-1 : ℤ) ^ (i : ℕ) :
begin
  rw [fin.prod_univ_succ, fin.prod_univ_succ, mul_assoc],
  unfold_coes,
  simp [nat.succ_eq_add_one, pow_add],
  refl,
end

end list


import data.int.basic

def zpow (x : ℤ) (y : ℤ) : ℤ := x ^ int.to_nat y

namespace zpow

instance : has_pow ℤ ℤ := ⟨zpow⟩

@[simp] lemma zpow_eq_pow (x y : ℤ) : zpow x y = x ^ y := rfl

lemma zpow_def (x y : ℤ) : x ^ y = x ^ int.to_nat y := rfl

@[simp] lemma zpow_zero (x : ℤ) : x ^ (0 : ℤ) = 1 :=
by simp [zpow_def, int.to_nat_zero]

-- TODO: Move.
lemma int.to_nat_nonneg (x : ℤ) : 0 ≤ int.to_nat x := by simp

@[simp] lemma zpow_eq_zero_iff (x y : ℤ) : x ^ y = 0 ↔ x = 0 ∧ 0 < y :=
begin
    simp only [zpow_def],
    split,
    { intros h, refine ⟨_, _⟩,
      exact (pow_eq_zero h),
      cases y,
      { erw int.to_nat_coe_nat at h,
        cases y,
        { rw pow_zero at h, cases h, },
        { have hy := int.lt_add_succ 0 y,
          rw zero_add at hy,
          exact hy, } },
      { rw [int.to_nat_zero_of_neg (int.neg_succ_lt_zero y)] at h,
        rw pow_zero at h, cases h, }, },
    { rintros ⟨hx, hy⟩,
      have hy' : 0 < int.to_nat y := int.to_nat_zero ▸ (int.to_nat_lt_to_nat hy).2 hy,
      rw [hx, zero_pow hy'], },
end

@[simp] lemma zero_zpow {x : ℤ} (h : x > 0) : (0 : ℤ) ^ x = 0 :=
(zpow_eq_zero_iff 0 x).mpr ⟨rfl, h⟩

@[simp] lemma zpow_one (x : ℤ) : x ^ (1 : ℤ) = x :=
by simp only [zpow_def, int.to_nat_one]; exact pow_one x

@[simp] lemma one_zpow (x : ℤ) : (1 : ℤ) ^ x = 1 :=
by simp only [zpow_def]; exact one_pow (int.to_nat x)

lemma zpow_add {x : ℤ} (y z : ℤ) (hy : 0 ≤ y) (hz : 0 ≤ z)
: x ^ (y + z) = x ^ y * x ^ z :=
by simp only [zpow_def, int.to_nat_add hy hz]; exact (pow_add _ _ _)

-- TODO: Move.
lemma int.to_nat_mul {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) :
  (a * b).to_nat = a.to_nat * b.to_nat :=
begin
  lift a to ℕ using ha,
  lift b to ℕ using hb,
  norm_cast,
end

lemma zpow_mul {x y : ℤ} (z : ℤ) (hy : 0 ≤ y) (hz : 0 ≤ z)
: x ^ (y * z) = (x ^ y) ^ z :=
by simp only [zpow_def, int.to_nat_mul hy hz]; exact (pow_mul x _ _)

@[simp] lemma zpow_nat_cast (x : ℤ) : ∀ (n : ℕ), x ^ (n : ℤ) = x ^ n :=
λ n, by simp only [zpow_def]; rw int.to_nat_coe_nat

end zpow


import analysis.specific_limits.normed

open_locale big_operators

theorem tsum_coe_mul_geometric_succ
{x : ℝ} (hx1: x<1) (hx2 : 0 < x)
:
∑' k : ℕ, (k + 1 : ℝ)*(x^(k+1)) = x/(1-x)^2
:=
begin
  have hxnorm : ‖x‖ < 1, {refine abs_lt.mpr ⟨_, _⟩ ; linarith },
  conv{find (_*_){rw [pow_succ, mul_comm x _, ← mul_assoc, right_distrib, one_mul],}},
  rw [tsum_mul_right, tsum_add, tsum_coe_mul_geometric_of_norm_lt_1, tsum_geometric_of_lt_1, inv_eq_one_div, right_distrib,
  show x/(1-x)^2*x = x^2/(1-x)^2, by {field_simp, rw ← pow_two}, mul_comm (1/_) x, ← mul_div_assoc x 1 _, mul_one, show  x^2/(1-x)^2+x/(1-x) = x/(1-x)^2,
  by {rw [show x^2/(1-x)^2+x/(1-x) = x/(1-x)*(x/(1-x)+1), by {rw left_distrib, simp, rw [← pow_two, div_pow]},
  div_add_one, ← add_sub_assoc, add_sub_cancel', pow_two], field_simp, nlinarith}],
  iterate 3 {linarith},
  simpa using summable_pow_mul_geometric_of_norm_lt_1 1 hxnorm,
  simpa using summable_geometric_of_norm_lt_1 hxnorm,
end

theorem tsum_geometric_of_lt_1_pow_succ
{x : ℝ}(hx1: x<1)(hx2 : 0 < x)
:
∑' k, x^(k+1) = x/(1-x)
:=
begin
conv{find (x^(_+1)){rw [pow_succ, mul_comm x _],}},
rw [tsum_mul_right, tsum_geometric_of_lt_1, inv_eq_one_div, mul_comm, ← mul_div_assoc, mul_one],
iterate 2 {linarith},
end

namespace nnreal

theorem tsum_eq_zero_add {f : ℕ → nnreal} (hf : summable f) :
∑' (b : ℕ), f b = f 0 + ∑' (b : ℕ), f (b + 1) :=
begin
  apply subtype.ext,
  push_cast,
  let g : ℕ → ℝ := λ n, f n,
  have hg : summable g,
  { apply summable.map hf (nnreal.to_real_hom : nnreal →+ ℝ) continuous_induced_dom },
  exact tsum_eq_zero_add hg,
end

theorem tsum_coe_mul_geometric_of_norm_lt_1 {r : nnreal} (hr : r < 1) :
∑' (n : ℕ), (↑n) * r ^ n = r / (1 - r) ^ 2 :=
begin
have hr' : ‖(r : ℝ)‖ < 1,
{ rw [real.norm_eq_abs, abs_lt],
split,
{ refine lt_of_lt_of_le _ r.coe_nonneg, norm_num },
{ exact_mod_cast hr } },
apply nnreal.coe_injective,
convert tsum_coe_mul_geometric_of_norm_lt_1 hr',
{ norm_cast },
{ push_cast,
rw nnreal.coe_sub hr.le,
norm_cast },
end

end nnreal


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Mathlib.Algebra.Group.Defs
import Moncalc.CategoryTheory.Monoidal.Unbiased

/-!
# Unbiased monoical structure on `Nat`

`Nat` becomes an unbiased monoidal category as a poset.
-/

namespace List

variable {α : Type u} [AddMonoid α]

def sum : List α → α :=
  List.foldr (·+·) 0

theorem sum_nil : sum (α:=α) [] = 0 := rfl

theorem sum_cons (a : α) (as : List α) : sum (a::as) = a + sum as := rfl

theorem sum_append (as bs : List α) : (as++bs).sum = as.sum + bs.sum := by
  induction as
  case nil =>
    change sum bs = 0 + sum bs
    rw [AddMonoid.zero_add]
  case cons a as h_ind =>
    dsimp
    change a + sum (as++bs) = a + sum as + sum bs
    rw [h_ind]
    rw [AddSemigroup.add_assoc]

theorem sum_join (ass : List (List α)) : ass.join.sum = (ass.map sum).sum := by
  induction ass
  case nil => rfl
  case cons n ns h_ind =>
    dsimp
    rw [sum_append, sum_cons, h_ind]

end List

inductive LEHom : Nat → Nat → Type
| mk {m n : Nat} : m ≤ n → LEHom m n

namespace LEHom

@[reducible]
protected
def comp {l m n : Nat} : LEHom l m → LEHom m n → LEHom l n
| mk hlm, mk hmn => mk (trans hlm hmn)

protected
def sum : {ms ns : List Nat} → (hs : DVect2 LEHom ms ns) → LEHom ms.sum ns.sum
| [], [], DVect2.nil => mk (Nat.le_refl 0)
| (_::_), (_::_), DVect2.cons (mk h) hs => mk $ by
  simp
  let (mk h_ind) := LEHom.sum hs
  exact Nat.add_le_add h h_ind

end LEHom

open CategoryTheory

instance instCateroyNatWithLE : Category Nat where
  Hom := LEHom
  id n := LEHom.mk (Nat.le_refl n)
  comp := LEHom.comp

def isoOfEq {m n : Nat} (h : m = n) : m ≅ n where
  hom := LEHom.mk (Nat.le_of_eq h)
  inv := LEHom.mk (Nat.le_of_eq h.symm)

instance instUnbiasedMonoidalNatWithLT : UnbiasedMonoidal Nat where
  tensor := {obj := List.sum, map := LEHom.sum}
  unitor := Iso.refl _
  associator := {
    hom := {app:=λ nss => (isoOfEq (List.sum_join nss)).inv}
    inv := {app:=λ nss => (isoOfEq (List.sum_join nss)).hom}
  }
  coherence_unit_left := rfl
  coherence_unit_right := rfl
  coherence_assoc := rfl


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland
-/
import algebra.ring.inj_surj
import algebra.group.units

/-!
# Units in semirings and rings

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
-/
universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open function

namespace units

section has_distrib_neg
variables [monoid α] [has_distrib_neg α] {a b : α}

/-- Each element of the group of units of a ring has an additive inverse. -/
instance : has_neg αˣ := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩

/-- Representing an element of a ring's unit group as an element of the ring commutes with
    mapping this element to its additive inverse. -/
@[simp, norm_cast] protected theorem coe_neg (u : αˣ) : (↑-u : α) = -u := rfl

@[simp, norm_cast] protected theorem coe_neg_one : ((-1 : αˣ) : α) = -1 := rfl

instance : has_distrib_neg αˣ := units.ext.has_distrib_neg _ units.coe_neg units.coe_mul

@[field_simps] lemma neg_divp (a : α) (u : αˣ) : -(a /ₚ u) = (-a) /ₚ u :=
by simp only [divp, neg_mul]

end has_distrib_neg

section ring

variables [ring α] {a b : α}

@[field_simps] lemma divp_add_divp_same (a b : α) (u : αˣ) :
  a /ₚ u + b /ₚ u = (a + b) /ₚ u :=
by simp only [divp, add_mul]

@[field_simps] lemma divp_sub_divp_same (a b : α) (u : αˣ) :
  a /ₚ u - b /ₚ u = (a - b) /ₚ u :=
by rw [sub_eq_add_neg, sub_eq_add_neg, neg_divp, divp_add_divp_same]

@[field_simps] lemma add_divp (a b : α) (u : αˣ)  : a + b /ₚ u = (a * u + b) /ₚ u :=
by simp only [divp, add_mul, units.mul_inv_cancel_right]

@[field_simps] lemma sub_divp (a b : α) (u : αˣ) : a - b /ₚ u = (a * u - b) /ₚ u :=
by simp only [divp, sub_mul, units.mul_inv_cancel_right]

@[field_simps] lemma divp_add (a b : α) (u : αˣ) : a /ₚ u + b = (a + b * u) /ₚ u :=
by simp only [divp, add_mul, units.mul_inv_cancel_right]

@[field_simps] lemma divp_sub (a b : α) (u : αˣ) : a /ₚ u - b = (a - b * u) /ₚ u :=
begin
  simp only [divp, sub_mul, sub_right_inj],
  assoc_rw [units.mul_inv, mul_one],
end

end ring

end units

lemma is_unit.neg [monoid α] [has_distrib_neg α] {a : α} : is_unit a → is_unit (-a)
| ⟨x, hx⟩ := hx ▸ (-x).is_unit

@[simp]
lemma is_unit.neg_iff [monoid α] [has_distrib_neg α] (a : α) : is_unit (-a) ↔ is_unit a :=
⟨λ h, neg_neg a ▸ h.neg, is_unit.neg⟩

lemma is_unit.sub_iff [ring α] {x y : α} :
  is_unit (x - y) ↔ is_unit (y - x) :=
(is_unit.neg_iff _).symm.trans $ neg_sub x y ▸ iff.rfl

namespace units

@[field_simps] lemma divp_add_divp [comm_ring α] (a b : α) (u₁ u₂ : αˣ) :
a /ₚ u₁ + b /ₚ u₂ = (a * u₂ + u₁ * b) /ₚ (u₁ * u₂) :=
begin
  simp only [divp, add_mul, mul_inv_rev, coe_mul],
  rw [mul_comm (↑u₁ * b), mul_comm b],
  assoc_rw [mul_inv, mul_inv, mul_one, mul_one],
end

@[field_simps]

lemma add_eq_mul_one_add_div [semiring R] {a : Rˣ} {b : R} : ↑a + b = a * (1 + ↑a⁻¹ * b) :=
by rwa [mul_add, mul_one, ← mul_assoc, units.mul_inv, one_mul]

end units


/-
A logic is a "formal language" that has
a mathematically defined syntax and a
mathematically defined semantics. The
semantics in turn depends on an intended
"real-world interpretation" of the basic
symbols in a given logical expression.

Consider for example this proposition
∀ p : Person, ∃ m: Person, motherOf p m.
We could have written it in a logically
equivalent form: ∀ x : X, ∃ m : X, r p m.
The benefit of the first version is that
it *suggests* an intended interpretation.
We mean for p and m to represent people
(any human beings), and we intend the
motherOf predicate to represent the real
relationship connecting people to moms.

We now drill down on the notions of the
syntax and semantics of a formal language.
The syntax of a language defines the set
of valid expressions in the language. In
predicate logic, for example, ∀ p: Person,
∃ m : Person, motherOf p m is well formed.
However, the expression, ∀ ∃ r, is not.

The semantics of a language then assigns
a meaning of some kind to each expression
in the language given an interpretation
of the basic elements of an expression.
When the formal language is a logic, the
syntax defines a language of propositions,
predicates, etc., while a semantics tells
us how to evaluate the truth of any such
expression.

In this unit we begin by formalizing the
syntax, interpretation, and semantics of
propositional logic. Proposition logic is
a very simple logic, one that essentially
mirrors (is "isomorphic to") the language
of Boolean expressions.
-/

-- Syntax

/-
We formalize the syntax of a language
with an inductive definition of the set
of valid expressions.

An expression in propositional logic
is built from a (1) a logical constant,
true or false, (2) a propositional (you
can think "Boolean") variable, or (3) a
logical connective (and, or, not, etc)
and one or more smaller expressions.
-/

/-
To formalize this idea, we need to
define what we mean by a variable.
We do with with a new type, pVar,
where each such variable holds a ℕ
value that distinguishes it from any
other propVar.
-/

inductive pVar : Type
| mk : ℕ → pVar

-- Examples

def X := pVar.mk 0
def Y := pVar.mk 1
def Z := pVar.mk 2
def W := pVar.mk 3

def pVar_eq (v1 v2 : pVar) : bool :=
match v1, v2 with
    (pVar.mk m), (pVar.mk n) := m = n
end

#reduce pVar_eq X X
#reduce pVar_eq X Y

def Q := pVar.mk 0
#reduce pVar_eq Q X

/-
Now we formalize a language of
expressions in propositional logic.
-/

inductive pExp : Type
| mk_lit_pexp : bool → pExp
| mk_var_pexp : pVar → pExp
| mk_not_pexp : pExp → pExp
| mk_and_pexp : pExp → pExp → pExp
| mk_or_pexp  : pExp → pExp → pExp

open pExp

-- Examples of expressions

def ff_exp := mk_lit_pexp ff
def tt_exp := mk_lit_pexp tt
#reduce tt_exp

def X_exp := mk_var_pexp X
def Y_exp := mk_var_pexp Y
def Z_exp := mk_var_pexp Z
#reduce Z_exp

def not_X_exp := mk_not_pexp X_exp
def and_X_Y_exp := mk_and_pexp X_exp Y_exp
def and_X_Z_exp := mk_and_pexp X_exp Z_exp
def or_X_Y_exp := mk_or_pexp X_exp Y_exp
#reduce and_X_Z_exp

-- syntactic sugar!

notation e1 ∧ e2 :=  mk_and_pexp e1 e2
notation e1 ∨ e2 := mk_or_pexp e1 e2
notation ¬ e := mk_not_pexp e

def not_X_exp' := ¬ X_exp
def and_X_Y_exp' := X_exp ∧ Y_exp
def and_X_Z_exp' := X_exp ∧ Z_exp
def or_X_Y_exp' := X_exp ∨ Y_exp

def tf := mk_and_pexp (mk_lit_pexp tt) (mk_lit_pexp ff)
def nt := mk_not_pexp (mk_lit_pexp tt)
def nxy := mk_not_pexp (mk_and_pexp X_exp Y_exp)

-- Semantics

/-
To formalize a semantics for our
realization of propositional logic,
we need to formally define what we
mean by an interpretation.

An interpretation in propositional
logic is a function from propositional
variables to corresponding (Boolean)
truth values. An interpretation tells
us what each variable "means" -- i.e.,
whether it means true, or false.

We now define a name for the type
of an interpretation (pVar → bool).
Then we present several examples of
interpretations.
-/

def pInterp := pVar → bool

-- an "all false" interpretation
def falseInterp (v : pVar) : bool :=
    ff

-- an "all true" interpretation
def trueInterp (v : pVar) :=
    tt

-- X = tt, Y=ff, Z=tt, _ = ff

def anInterp: pInterp :=
λ(v: pVar),
  match v with
  | (pVar.mk 0) := tt     -- X
  | (pVar.mk 1) := ff     -- Y
  | (pVar.mk 2) := tt     -- Z
  | _ := ff               -- otherwise
  end

-- Semantics

/-
We now define a semantics for our
language in the form of a function
that, when given any expression in
our language *and* an interpretation
for the variables that might appear
in it, evaluates its truth value and
returns it as a result.

The definition is by cases, i.e.,
with one rule for each possible form
(constructor) of expression.

Note: Lean "overloads" logical
operator notations, such as ∧, ∨,
and ¬. Here they are applied not to
values of type Prop, but to values
of type bool, where they have their
usual means from Boolean algebra.
-/

def pEval : pExp → pInterp → bool
-- how to evaluate literal expression
| (mk_lit_pexp b) i := b
-- how to evaluate variable expression
| (mk_var_pexp v) i := i v
-- how to evaluate a "not" expression
| (mk_not_pexp e) i := bnot (pEval e i)
-- how to evaluate an "and" expression
| (mk_and_pexp e1 e2) i :=
    band (pEval e1 i) (pEval e2 i)
| (mk_or_pexp e1 e2) i :=
    bor (pEval e1 i) (pEval e2 i)

/-
And now we have a formal language, with
a syntax, interpretations, and semantics.
Let's evaluate some of our expressions
under varying interpretations.
-/

-- literal expressions

#reduce pEval tt_exp falseInterp
#reduce pEval tt_exp trueInterp
#reduce pEval tt_exp anInterp

#reduce pEval ff_exp falseInterp
#reduce pEval ff_exp trueInterp
#reduce pEval ff_exp anInterp

-- variable expressions
#reduce pEval X_exp falseInterp
#reduce pEval X_exp trueInterp
#reduce pEval X_exp anInterp

#reduce pEval Y_exp falseInterp
#reduce pEval Y_exp trueInterp
#reduce pEval Y_exp anInterp

#reduce pEval Z_exp falseInterp
#reduce pEval Z_exp trueInterp
#reduce pEval Z_exp anInterp

#reduce pEval (mk_var_pexp W) falseInterp
#reduce pEval (mk_var_pexp W) trueInterp
#reduce pEval (mk_var_pexp W) anInterp

-- We don't have to give variables names
#reduce pEval (mk_var_pexp (pVar.mk 10)) anInterp

-- not expression
#reduce pEval not_X_exp falseInterp
#reduce pEval not_X_exp trueInterp
#reduce pEval not_X_exp anInterp

-- and expressio
#reduce pEval and_X_Z_exp falseInterp
#reduce pEval and_X_Z_exp trueInterp
#reduce pEval and_X_Z_exp anInterp

#reduce pEval and_X_Z_exp' falseInterp
#reduce pEval and_X_Z_exp' trueInterp
#reduce pEval and_X_Z_exp' anInterp

#reduce pEval and_X_Y_exp anInterp

/-
So there you have it: a complete
formal definition of the syntax,
interpretation, and semantics of
propositional logic, in Lean, with
a nice "surface syntax," to boot.
(Ok, it's complete except for the
definitions for the other logical
connectives. You will add some of
them in homework and on the exam.)
-/

/-
From here, we can define richer
functions, such as functions that
analyze expressions; and we can
even state and prove theorems
about our language.
-/

/-
A function that returns the set
of variables in a given pExp.
-/

/-
Helper function that adds variables
in given expression to given set of
variables.
-/
def vars_in_exp_helper:
    pExp → set pVar → set pVar
| (mk_lit_pexp _) s := s
| (mk_var_pexp v) s := s ∪ { v }
| (mk_not_pexp e) s :=
    s ∪ (vars_in_exp_helper e s)
| (mk_and_pexp e1 e2) s :=
    s ∪
    (vars_in_exp_helper e1 s) ∪
    (vars_in_exp_helper e2 s)
| (mk_or_pexp e1 e2) s :=
    s ∪
    (vars_in_exp_helper e1 s) ∪
    (vars_in_exp_helper e2 s)

/-
Main function: add variables in given
expression to initially empty set and
return result.
-/
def vars_in_exp (e: pExp) : set pVar :=
    vars_in_exp_helper e ({}: set pVar)

#reduce vars_in_exp and_X_Y_exp
#reduce vars_in_exp and_X_Z_exp

/-
EXERCISE: Write a function that when
given an expression, e, returns the
"nesting depth" of the expression. The
nesting depth of a literal or variable
expression is 1. The depth of a (not e)
expression is 1 + the depth of e. And
the depth of an (and e1 e2) expression
is 1 + the max of the depths of e1 and
e2. You can use the Lean-provided max function in your answer.
-/

#reduce max 5 7
#reduce max 7 5

/-
We can also prove theorems about
our language in general. Here's a
proof that evaluation under a given
interpretation is deterministic. It
always produces the same result.
This is really just a corollary of
the fact that functions in Lean are
single valued and we've defined the
semantics of expressions with a
function.
-/

theorem pEval_deterministic :
∀ e : pExp,
∀ i : pInterp,
∀ v1 v2 : bool,
v1 = pEval e i → v2 = pEval e i → v1 = v2 :=
begin
intros e i v1 v2 h_v1 h_v2,
rw h_v1,
rw h_v2,
end

/-
We can also prove theorems about
particular expressions in our language.
For example, if X_exp is some variable
expression, then the expression
X_exp ∧ (¬ X_exp) is false under *any*
interpretation.
-/

theorem contra :
∀ V : pVar,
∀ i : pInterp,
pEval
    ((mk_var_pexp V) ∧ ¬ (mk_var_pexp V)) i = ff
:=
begin
intros X i,
simp [pEval],
-- case analysis on result of function!
cases (i X),
left, apply rfl,
right, apply rfl,
end

/-
EXERCISE: extend the syntax, surface
syntax, and semantics of the language
with an "or" operator. Use ∨ as surface
syntax.
-/

/-
Exercise: now prove that for any
variable, V, the logical expression
(mk_var_exp V) ∨ (¬ (mk_var_exp V))
always evaluates to true.
-/


import data.real.basic
import data.nat.prime

/- Structures and classes.

Corresponding LFTCM lectures:
* https://www.youtube.com/watch?v=xYenPIeX6MY
* https://www.youtube.com/watch?v=1W_fyjaaY0M
-/

/- The `structure` command introduces a new type (or proposition)
which is built up from existing types.
Let's start with a basic example of a structure. -/

structure complex : Type :=
(re : ℝ)
(im : ℝ)

variables (w : complex)

/- Field projections. -/
#check w.re
#check w.im

/- The "dot notation" above is short for: -/
#check complex.re w
#check complex.im w

/- Constructing values. These four lines below are exactly equivalent.
By default, the constructor of a structure is named `mk`. -/
#check complex.mk 1 2
#check (⟨1, 2⟩ : complex)
#check ({ re := 1, im := 2 } : complex)
#check { complex . re := 1, im := 2 }

/-
`{ re := ..., im := ... }` is "record constructor syntax"
and ⟨..., ...⟩ is "anonymous constructor syntax.
When the expected type is known, we can omit it from the notation.
-/

#check (show complex, from ⟨1, 2⟩)
#check (show complex, from { re := 1, im := 2 })

/- The "dot notation" is not specific to fields of structures;
it works with any qualified name (= name in a namespace).
If the type of `x` is of the form `T a1 ... an`,
then `x.y` is interpreted as `T.y x`. -/

variables (n : nat)
#check nat.prime n
#check n.prime

/- Let's add a complex conjugation function,
and prove that taking the conjugate twice is the identity. -/

def complex.conj (z : complex) : complex :=
{ re := z.re, im := - z.im }    -- or ⟨z.re, - z.im⟩

lemma complex.conj_conj (z : complex) : z.conj.conj = z :=
begin
  sorry
end

/-
Above, we manipulated the equation `z.conj.conj = z` into a form
equating two record constructor applications.
Another strategy is to reason about the two components separately.
For this we use an "extensionality" lemma:
two complex numbers are equal if they are built from the same components.
We can automatically derive this lemma using the `ext` attribute.
-/

attribute [ext] complex    -- or add `@[ext]` before `structure complex`

#check @complex.ext

/-
This strategy pairs well with lemmas which describe the components of `z.conj`.
(These can also be automatically generated using the `simps` attribute.)
-/

lemma complex.conj_re (z : complex) : z.conj.re = z.re := rfl
lemma complex.conj_im (z : complex) : z.conj.im = - z.im := rfl

example (z : complex) : z.conj.conj = z :=
begin
  sorry
end

/- Let's now look at some more interesting examples of structures. -/

structure Prime : Type :=
(val : ℕ)
(is_prime : nat.prime val)

/-
`Prime` is a type whose values correspond to the prime numbers.
A value of type `Prime` is a natural number `val`
together with a "proof" that the number `val` is prime;
or in more ordinary language, a natural number `val` such that `val` is prime.

Combining data and properties like this is sometimes called "bundling".
For example, we could call an argument `(p : Prime)` a "bundled prime number"
to distinguish it from two arguments `(p : ℕ) (hp : nat.prime p)`.
(In general "bundling" is a relative notion, and there might be
more than two possible levels of bundled-ness.)
-/

variables (p : Prime)

#check p.val
#check p.is_prime

/-
In order to construct a value of type `Prime`,
we have to provide a proof of primality.
-/
#check show Prime, from ⟨5, by norm_num⟩

/-
This example generalizes to any type and predicate on that type (or subset of that type).
-/

#check @subtype

def Prime2 : Type := { p : ℕ // p.prime }    -- or `subtype nat.prime`

-- compare:
def primes : set ℕ := { p : ℕ | p.prime }

variables (q : Prime2)

#check q.val
#check q.property

/- Other basic structures: -/
#check and

#check @prod

/-
Another important kind of "data with properties" are algebraic structures.
-/

structure monoid_structure (α : Type) : Type :=
(one : α)
(mul : α → α → α)
(mul_one : ∀ x, mul x one = x)
(one_mul : ∀ x, mul one x = x)
(mul_assoc : ∀ x y z, mul (mul x y) z = mul x (mul y z))

def nat_mul_monoid : monoid_structure ℕ :=
sorry

def int_mul_monoid : monoid_structure ℤ :=
sorry

#eval nat_mul_monoid.mul 2 3

#eval int_mul_monoid.mul (-1) 5

/-
Recall that the dot notation is another way to write:
-/

#eval monoid_structure.mul nat_mul_monoid 2 3

#eval monoid_structure.mul int_mul_monoid (-1) 5

namespace monoid_structure

/- Example function defined in terms of a `monoid_structure`:
power x^n of an element x of a monoid. -/
def pow {α : Type} (m : monoid_structure α) (x : α) : ℕ → α
| 0 := m.one
| (n+1) := m.mul (pow n) x

#eval nat_mul_monoid.pow 2 5

-- a^(m+n) = a^m * a^n
lemma pow_add {α : Type} (M : monoid_structure α) (a : α) (m n : ℕ) :
  M.pow a (m + n) = M.mul (M.pow a m) (M.pow a n) :=
begin
  induction n with n IH,
  { symmetry,
    apply M.mul_one },
  { calc M.pow a (m + (n + 1))
        = M.pow a ((m + n) + 1)                   : rfl
    ... = M.mul (M.pow a (m + n)) a               : rfl
    ... = M.mul (M.mul (M.pow a m) (M.pow a n)) a : by rw IH
    ... = M.mul (M.pow a m) (M.mul (M.pow a n) a) : by rw M.mul_assoc
    ... = M.mul (M.pow a m) (M.pow a (n+1))       : rfl }
end

end monoid_structure            -- end namespace

-- To use this lemma, we need to pass the `monoid_structure` explicitly.
#check nat_mul_monoid.pow_add 2 3 5

/-
We would like Lean to automatically know
to use `nat_mul_monoid` when it needs a `monoid_structure ℕ`,
and `int_mul_monoid` when it needs a `monoid_structure ℤ`.
This is what the type class system is for.
Lean maintains a database of "instances" for each "type class",
and it searches this database when it needs to infer
an argument which is passed in square brackets.
-/

/- `class` is the same as `structure`,
except it also makes the structure a type class. -/
class my_monoid (α : Type) : Type :=
(one : α)
(mul : α → α → α)
(mul_one : ∀ x, mul x one = x)
(one_mul : ∀ x, mul one x = x)
(mul_assoc : ∀ x y z, mul (mul x y) z = mul x (mul y z))

/- Register instances with the type class system
so they are available to instance search. -/
instance : my_monoid ℕ :=
{ one := 1,
  mul := nat.mul,
  mul_one := nat.mul_one,
  one_mul := nat.one_mul,
  mul_assoc := nat.mul_assoc }

instance : my_monoid ℤ :=
{ one := 1,
  mul := int.mul,
  mul_one := int.mul_one,
  one_mul := int.one_mul,
  mul_assoc := int.mul_assoc }

/- The monoid structure is now an argument passed in square brackets. -/
#check @monoid_structure.mul

#check @my_monoid.mul

/- This means we don't write the argument explicitly.
Instead, Lean will search its database for a matching instance. -/
#eval my_monoid.mul 2 3
#eval my_monoid.mul (-1 : ℤ) 5

namespace my_monoid

/- Square brackets tell Lean that the argument will be supplied by instance search.
It is then also available for other functions, like `mul`. -/
def pow {α : Type} [my_monoid α] (x : α) : ℕ → α
| 0 := one
| (n+1) := mul (pow n) x

/- Same as original `pow_add`, but now all explicit references
to the monoid structure are gone. -/
lemma pow_add {α : Type} [my_monoid α] (a : α) (m n : ℕ) :
  pow a (m + n) = mul (pow a m) (pow a n) :=
begin
  induction n with n IH,
  { symmetry,
    apply mul_one },
  { calc pow a (m + (n + 1))
        = pow a ((m + n) + 1)             : rfl
    ... = mul (pow a (m + n)) a           : rfl
    ... = mul (mul (pow a m) (pow a n)) a : by rw IH
    ... = mul (pow a m) (mul (pow a n) a) : by rw mul_assoc
    ... = mul (pow a m) (pow a (n+1))     : rfl }
end

end my_monoid                   -- end namespace

-- No longer need to explicitly pass the monoid structure.
#check my_monoid.pow_add 2 3 5

-- By adding notation, we could get a type like the actual lemma `pow_add`.
#check @my_monoid.pow_add

#check @pow_add

/-
Exercises:
LFTCM exercises (https://leanprover-community.github.io/lftcm2020/exercises.html)
file `wednesday/structures.lean`.
I especially recommend solving Exercises 1 and 2 from that file
and checking your answers with one of the instructors.
-/


/-
Copyright (c) 2022 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import dynamics.ergodic.add_circle
import measure_theory.covering.liminf_limsup
import data.nat.totient

/-!
# Well-approximable numbers and Gallagher's ergodic theorem

Gallagher's ergodic theorem is a result in metric number theory. It thus belongs to that branch of
mathematics concerning arithmetic properties of real numbers which hold almost eveywhere with
respect to the Lebesgue measure.

Gallagher's theorem concerns the approximation of real numbers by rational numbers. The input is a
sequence of distances `δ₁, δ₂, ...`, and the theorem concerns the set of real numbers `x` for which
there is an infinity of solutions to:
$$
  |x - m/n| < δₙ,
$$
where the rational number `m/n` is in lowest terms. The result is that for any `δ`, this set is
either almost all `x` or almost no `x`.

This result was proved by Gallagher in 1959
[P. Gallagher, *Approximation by reduced fractions*](Gallagher1961). It is formalised here as
`add_circle.add_well_approximable_ae_empty_or_univ` except with `x` belonging to the circle `ℝ ⧸ ℤ`
since this turns out to be more natural.

Given a particular `δ`, the Duffin-Schaeffer conjecture (now a theorem) gives a criterion for
deciding which of the two cases in the conclusion of Gallagher's theorem actually occurs. It was
proved by Koukoulopoulos and Maynard in 2019
[D. Koukoulopoulos, J. Maynard, *On the Duffin-Schaeffer conjecture*](KoukoulopoulosMaynard2020).
We do *not* include a formalisation of the Koukoulopoulos-Maynard result here.

## Main definitions and results:

 * `approx_order_of`: in a seminormed group `A`, given `n : ℕ` and `δ : ℝ`, `approx_order_of A n δ`
   is the set of elements within a distance `δ` of a point of order `n`.
 * `well_approximable`: in a seminormed group `A`, given a sequence of distances `δ₁, δ₂, ...`,
   `well_approximable A δ` is the limsup as `n → ∞` of the sets `approx_order_of A n δₙ`. Thus, it
   is the set of points that lie in infinitely many of the sets `approx_order_of A n δₙ`.
 * `add_circle.add_well_approximable_ae_empty_or_univ`: *Gallagher's ergodic theorem* says that for
   for the (additive) circle `𝕊`, for any sequence of distances `δ`, the set
   `add_well_approximable 𝕊 δ` is almost empty or almost full.

## TODO:

The hypothesis `hδ` in `add_circle.add_well_approximable_ae_empty_or_univ` can be dropped.
An elementary (non-measure-theoretic) argument shows that if `¬ hδ` holds then
`add_well_approximable 𝕊 δ = univ` (provided `δ` is non-negative).
-/

open set filter function metric measure_theory
open_locale measure_theory topology pointwise

/-- In a seminormed group `A`, given `n : ℕ` and `δ : ℝ`, `approx_order_of A n δ` is the set of
elements within a distance `δ` of a point of order `n`. -/
@[to_additive approx_add_order_of "In a seminormed additive group `A`, given `n : ℕ` and `δ : ℝ`,
`approx_add_order_of A n δ` is the set of elements within a distance `δ` of a point of order `n`."]
def approx_order_of (A : Type*) [seminormed_group A] (n : ℕ) (δ : ℝ) : set A :=
thickening δ {y | order_of y = n}

@[to_additive mem_approx_add_order_of_iff]
lemma mem_approx_order_of_iff {A : Type*} [seminormed_group A] {n : ℕ} {δ : ℝ} {a : A} :
  a ∈ approx_order_of A n δ ↔ ∃ (b : A), order_of b = n ∧ a ∈ ball b δ :=
by simp only [approx_order_of, thickening_eq_bUnion_ball, mem_Union₂, mem_set_of_eq, exists_prop]

/-- In a seminormed group `A`, given a sequence of distances `δ₁, δ₂, ...`, `well_approximable A δ`
is the limsup as `n → ∞` of the sets `approx_order_of A n δₙ`. Thus, it is the set of points that
lie in infinitely many of the sets `approx_order_of A n δₙ`. -/
@[to_additive add_well_approximable "In a seminormed additive group `A`, given a sequence of
distances `δ₁, δ₂, ...`, `add_well_approximable A δ` is the limsup as `n → ∞` of the sets
`approx_add_order_of A n δₙ`. Thus, it is the set of points that lie in infinitely many of the sets
`approx_add_order_of A n δₙ`."]
def well_approximable (A : Type*) [seminormed_group A] (δ : ℕ → ℝ) : set A :=
blimsup (λ n, approx_order_of A n (δ n)) at_top (λ n, 0 < n)

@[to_additive mem_add_well_approximable_iff]
lemma mem_well_approximable_iff {A : Type*} [seminormed_group A] {δ : ℕ → ℝ} {a : A} :
  a ∈ well_approximable A δ ↔ a ∈ blimsup (λ n, approx_order_of A n (δ n)) at_top (λ n, 0 < n) :=
iff.rfl

namespace approx_order_of

variables {A : Type*} [seminormed_comm_group A] {a : A} {m n : ℕ} (δ : ℝ)

@[to_additive]
lemma image_pow_subset_of_coprime (hm : 0 < m) (hmn : n.coprime m) :
  (λ y, y^m) '' (approx_order_of A n δ) ⊆ approx_order_of A n (m * δ) :=
begin
  rintros - ⟨a, ha, rfl⟩,
  obtain ⟨b, hb, hab⟩ := mem_approx_order_of_iff.mp ha,
  replace hb : b^m ∈ {u : A | order_of u = n}, { rw ← hb at hmn ⊢, exact order_of_pow_coprime hmn },
  apply ball_subset_thickening hb ((m : ℝ) • δ),
  convert pow_mem_ball hm hab using 1,
  simp only [nsmul_eq_mul, algebra.id.smul_eq_mul],
end

@[to_additive]
lemma image_pow_subset (n : ℕ) (hm : 0 < m) :
  (λ y, y^m) '' (approx_order_of A (n * m) δ) ⊆ approx_order_of A n (m * δ) :=
begin
  rintros - ⟨a, ha, rfl⟩,
  obtain ⟨b, hb : order_of b = n * m, hab : a ∈ ball b δ⟩ := mem_approx_order_of_iff.mp ha,
  replace hb : b^m ∈ {y : A | order_of y = n},
  { rw [mem_set_of_eq, order_of_pow' b hm.ne', hb, nat.gcd_mul_left_left, n.mul_div_cancel hm], },
  apply ball_subset_thickening hb (m * δ),
  convert pow_mem_ball hm hab,
  simp only [nsmul_eq_mul],
end

@[to_additive]
lemma smul_subset_of_coprime (han : (order_of a).coprime n) :
  a • approx_order_of A n δ ⊆ approx_order_of A ((order_of a) * n) δ :=
begin
  simp_rw [approx_order_of, thickening_eq_bUnion_ball, ← image_smul, image_Union₂,
    image_smul, smul_ball'', smul_eq_mul, mem_set_of_eq],
  refine Union₂_subset_iff.mpr (λ b hb c hc, _),
  simp only [mem_Union, exists_prop],
  refine ⟨a * b, _, hc⟩,
  rw ← hb at ⊢ han,
  exact (commute.all a b).order_of_mul_eq_mul_order_of_of_coprime han,
end

@[to_additive vadd_eq_of_mul_dvd]
lemma smul_eq_of_mul_dvd (hn : 0 < n) (han : (order_of a)^2 ∣ n) :
  a • approx_order_of A n δ = approx_order_of A n δ :=
begin
  simp_rw [approx_order_of, thickening_eq_bUnion_ball, ← image_smul, image_Union₂,
    image_smul, smul_ball'', smul_eq_mul, mem_set_of_eq],
  replace han : ∀ {b : A}, order_of b = n → order_of (a * b) = n,
  { intros b hb,
    rw ← hb at han hn,
    rw sq at han,
    rwa [(commute.all a b).order_of_mul_eq_right_of_forall_prime_mul_dvd (order_of_pos_iff.mp hn)
      (λ p hp hp', dvd_trans (mul_dvd_mul_right hp' $ order_of a) han)], },
  let f : {b : A | order_of b = n} → {b : A | order_of b = n} := λ b, ⟨a * b, han b.property⟩,
  have hf : surjective f,
  { rintros ⟨b, hb⟩,
    refine ⟨⟨a⁻¹ * b, _⟩, _⟩,
    { rw [mem_set_of_eq, ← order_of_inv, mul_inv_rev, inv_inv, mul_comm],
      apply han,
      simpa, },
    { simp only [subtype.mk_eq_mk, subtype.coe_mk, mul_inv_cancel_left], }, },
  simpa only [f, mem_set_of_eq, subtype.coe_mk, Union_coe_set] using
    hf.Union_comp (λ b, ball (b : A) δ),
end

end approx_order_of

namespace unit_add_circle

lemma mem_approx_add_order_of_iff {δ : ℝ} {x : unit_add_circle} {n : ℕ} (hn : 0 < n) :
  x ∈ approx_add_order_of unit_add_circle n δ ↔
  ∃ m < n, gcd m n = 1 ∧ ‖x - ↑((m : ℝ) / n)‖ < δ :=
begin
  haveI := real.fact_zero_lt_one,
  simp only [mem_approx_add_order_of_iff, mem_set_of_eq, ball, exists_prop, dist_eq_norm,
    add_circle.add_order_of_eq_pos_iff hn, mul_one],
  split,
  { rintros ⟨y, ⟨m, hm₁, hm₂, rfl⟩, hx⟩, exact ⟨m, hm₁, hm₂, hx⟩, },
  { rintros ⟨m, hm₁, hm₂, hx⟩, exact ⟨↑((m : ℝ) / n), ⟨m, hm₁, hm₂, rfl⟩, hx⟩, },
end

lemma mem_add_well_approximable_iff (δ : ℕ → ℝ) (x : unit_add_circle) :
  x ∈ add_well_approximable unit_add_circle δ ↔
  {n : ℕ | ∃ m < n, gcd m n = 1 ∧ ‖x - ↑((m : ℝ) / n)‖ < δ n}.infinite :=
begin
  simp only [mem_add_well_approximable_iff, ← nat.cofinite_eq_at_top, cofinite.blimsup_set_eq,
    mem_set_of_eq],
  refine iff_of_eq (congr_arg set.infinite $ ext (λ n, ⟨λ hn, _, λ hn, _⟩)),
  { exact (mem_approx_add_order_of_iff hn.1).mp hn.2, },
  { have h : 0 < n := by { obtain ⟨m, hm₁, hm₂, hm₃⟩ := hn, exact pos_of_gt hm₁, },
    exact ⟨h, (mem_approx_add_order_of_iff h).mpr hn⟩, },
end

end unit_add_circle

namespace add_circle

variables {T : ℝ} [hT : fact (0 < T)]
include hT

local notation a `∤` b := ¬ a ∣ b
local notation a `∣∣` b := (a ∣ b) ∧ (a*a ∤ b)
local notation `𝕊` := add_circle T

/-- *Gallagher's ergodic theorem* on Diophantine approximation. -/
theorem add_well_approximable_ae_empty_or_univ (δ : ℕ → ℝ) (hδ : tendsto δ at_top (𝓝 0)) :
  (∀ᵐ x, ¬ add_well_approximable 𝕊 δ x) ∨ ∀ᵐ x, add_well_approximable 𝕊 δ x :=
begin
  /- Sketch of proof:

  Let `E := add_well_approximable 𝕊 δ`. For each prime `p : ℕ`, we can partition `E` into three
  pieces `E = (A p) ∪ (B p) ∪ (C p)` where:
    `A p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p ∤ n))`
    `B p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p ∣∣ n))`
    `C p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p*p ∣ n))`.
  (In other words, `A p` is the set of points `x` for which there exist infinitely-many `n` such
  that `x` is within a distance `δ n` of a point of order `n` and `p ∤ n`. Similarly for `B`, `C`.)

  These sets have the following key properties:
    1. `A p` is almost invariant under the ergodic map `y ↦ p • y`
    2. `B p` is almost invariant under the ergodic map `y ↦ p • y + 1/p`
    3. `C p` is invariant under the map `y ↦ y + 1/p`
  To prove 1 and 2 we need the key result `blimsup_thickening_mul_ae_eq` but 3 is elementary.

  It follows from `add_circle.ergodic_nsmul_add` and `ergodic.ae_empty_or_univ_of_image_ae_le` that
  if either `A p` or `B p` is not almost empty for any `p`, then it is almost full and thus so is
  `E`. We may therefore assume that both `A p` and `B p` are almost empty for all `p`. We thus have
  `E` is almost equal to `C p` for every prime. Combining this with 3 we find that `E` is almost
  invariant under the map `y ↦ y + 1/p` for every prime `p`. The required result then follows from
  `add_circle.ae_empty_or_univ_of_forall_vadd_ae_eq_self`. -/
  letI : semilattice_sup nat.primes := nat.subtype.semilattice_sup _,
  set μ : measure 𝕊 := volume,
  set u : nat.primes → 𝕊 := λ p, ↑(((↑(1 : ℕ) : ℝ) / p) * T),
  have hu₀ : ∀ (p : nat.primes), add_order_of (u p) = (p : ℕ),
  { rintros ⟨p, hp⟩, exact add_order_of_div_of_gcd_eq_one hp.pos (gcd_one_left p), },
  have hu : tendsto (add_order_of ∘ u) at_top at_top,
  { rw (funext hu₀ : add_order_of ∘ u = coe),
    have h_mono : monotone (coe : nat.primes → ℕ) := λ p q hpq, hpq,
    refine h_mono.tendsto_at_top_at_top (λ n, _),
    obtain ⟨p, hp, hp'⟩ := n.exists_infinite_primes,
    exact ⟨⟨p, hp'⟩, hp⟩, },
  set E := add_well_approximable 𝕊 δ,
  set X : ℕ → set 𝕊 := λ n, approx_add_order_of 𝕊 n (δ n),
  set A : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p ∤ n)),
  set B : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p ∣∣ n)),
  set C : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p^2 ∣ n)),
  have hA₀ : ∀ p, measurable_set (A p) :=
    λ p, measurable_set.measurable_set_blimsup (λ n hn, is_open_thickening.measurable_set),
  have hB₀ : ∀ p, measurable_set (B p) :=
    λ p, measurable_set.measurable_set_blimsup (λ n hn, is_open_thickening.measurable_set),
  have hE₀ : null_measurable_set E μ,
  { refine (measurable_set.measurable_set_blimsup
      (λ n hn, is_open.measurable_set _)).null_measurable_set,
    exact is_open_thickening, },
  have hE₁ : ∀ p, E = (A p) ∪ (B p) ∪ (C p),
  { intros p,
    simp only [E, add_well_approximable, ← blimsup_or_eq_sup, ← and_or_distrib_left, ← sup_eq_union,
      sq],
    congr,
    refine funext (λ n, propext $ iff_self_and.mpr (λ hn, _)),
    -- `tauto` can finish from here but unfortunately it's very slow.
    simp only [(em (p ∣ n)).symm, (em (p*p ∣ n)).symm, or_and_distrib_left, or_true, true_and,
      or_assoc], },
  have hE₂ : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∧ B p =ᵐ[μ] (∅ : set 𝕊) → E =ᵐ[μ] C p,
  { rintros p ⟨hA, hB⟩,
    rw hE₁ p,
    exact union_ae_eq_right_of_ae_eq_empty ((union_ae_eq_right_of_ae_eq_empty hA).trans hB), },
  have hA : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∨ A p =ᵐ[μ] univ,
  { rintros ⟨p, hp⟩,
    let f : 𝕊 → 𝕊 := λ y, (p : ℕ) • y,
    suffices : f '' (A p) ⊆
      blimsup (λ n, approx_add_order_of 𝕊 n (p * δ n)) at_top (λ n, 0 < n ∧ (p ∤ n)),
    { apply (ergodic_nsmul hp.one_lt).ae_empty_or_univ_of_image_ae_le (hA₀ p),
      apply (has_subset.subset.eventually_le this).congr eventually_eq.rfl,
      exact blimsup_thickening_mul_ae_eq μ
        (λ n, 0 < n ∧ (p ∤ n)) (λ n, {y | add_order_of y = n}) (nat.cast_pos.mpr hp.pos) _ hδ, },
    refine (Sup_hom.set_image f).apply_blimsup_le.trans (mono_blimsup $ λ n hn, _),
    replace hn := nat.coprime_comm.mp (hp.coprime_iff_not_dvd.2 hn.2),
    exact approx_add_order_of.image_nsmul_subset_of_coprime (δ n) hp.pos hn, },
  have hB : ∀ (p : nat.primes), B p =ᵐ[μ] (∅ : set 𝕊) ∨ B p =ᵐ[μ] univ,
  { rintros ⟨p, hp⟩,
    let x := u ⟨p, hp⟩,
    let f : 𝕊 → 𝕊 := λ y, p • y + x,
    suffices : f '' (B p) ⊆
      blimsup (λ n, approx_add_order_of 𝕊 n (p * δ n)) at_top (λ n, 0 < n ∧ (p ∣∣ n)),
    { apply (ergodic_nsmul_add x hp.one_lt).ae_empty_or_univ_of_image_ae_le (hB₀ p),
      apply (has_subset.subset.eventually_le this).congr eventually_eq.rfl,
      exact blimsup_thickening_mul_ae_eq μ
        (λ n, 0 < n ∧ (p ∣∣ n)) (λ n, {y | add_order_of y = n}) (nat.cast_pos.mpr hp.pos) _ hδ, },
    refine (Sup_hom.set_image f).apply_blimsup_le.trans (mono_blimsup _),
    rintros n ⟨hn, h_div, h_ndiv⟩,
    have h_cop : (add_order_of x).coprime (n/p),
    { obtain ⟨q, rfl⟩ := h_div,
      rw [hu₀, subtype.coe_mk, hp.coprime_iff_not_dvd, q.mul_div_cancel_left hp.pos],
      exact λ contra, h_ndiv (mul_dvd_mul_left p contra), },
    replace h_div : n / p * p = n := nat.div_mul_cancel h_div,
    have hf : f = (λ y, x + y) ∘ (λ y, p • y), { ext, simp [add_comm x], },
    simp_rw [comp_app],
    rw [le_eq_subset, Sup_hom.set_image_to_fun, hf, image_comp],
    have := @monotone_image 𝕊 𝕊 (λ y, x + y),
    specialize this (approx_add_order_of.image_nsmul_subset (δ n) (n/p) hp.pos),
    simp only [h_div] at this ⊢,
    refine this.trans _,
    convert approx_add_order_of.vadd_subset_of_coprime (p * δ n) h_cop,
    simp only [hu₀, subtype.coe_mk, h_div, mul_comm p], },
  change (∀ᵐ x, x ∉ E) ∨ E ∈ volume.ae,
  rw [← eventually_eq_empty, ← eventually_eq_univ],
  have hC : ∀ (p : nat.primes), (u p) +ᵥ C p = C p,
  { intros p,
    let e := (add_action.to_perm (u p) : equiv.perm 𝕊).to_order_iso_set,
    change e (C p) = C p,
    rw [e.apply_blimsup, ← hu₀ p],
    exact blimsup_congr (eventually_of_forall $ λ n hn,
      approx_add_order_of.vadd_eq_of_mul_dvd (δ n) hn.1 hn.2), },
  by_cases h : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∧ B p =ᵐ[μ] (∅ : set 𝕊),
  { replace h : ∀ (p : nat.primes), ((u p) +ᵥ E : set _) =ᵐ[μ] E,
    { intros p,
      replace hE₂ : E =ᵐ[μ] C p := hE₂ p (h p),
      have h_qmp : measure_theory.measure.quasi_measure_preserving ((+ᵥ) (-u p)) μ μ :=
        (measure_preserving_vadd _ μ).quasi_measure_preserving,
      refine (h_qmp.vadd_ae_eq_of_ae_eq (u p) hE₂).trans (ae_eq_trans _ hE₂.symm),
      rw hC, },
    exact ae_empty_or_univ_of_forall_vadd_ae_eq_self hE₀ h hu, },
  { right,
    simp only [not_forall, not_and_distrib] at h,
    obtain ⟨p, hp⟩ := h,
    rw hE₁ p,
    cases hp,
    { cases hA p, { contradiction, },
      simp only [h, union_ae_eq_univ_of_ae_eq_univ_left], },
    { cases hB p, { contradiction, },
      simp only [h, union_ae_eq_univ_of_ae_eq_univ_left, union_ae_eq_univ_of_ae_eq_univ_right], } },
end

end add_circle


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.coprime
import Mathlib.ring_theory.ideal.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Lemmas about Euclidean domains

Various about Euclidean domains are proved; all of them seem to be true
more generally for principal ideal domains, so these lemmas should
probably be reproved in more generality and this file perhaps removed?

## Tags

euclidean domain
-/

-- TODO -- this should surely be proved for PIDs instead?

theorem span_gcd {α : Type u_1} [euclidean_domain α] (x : α) (y : α) : ideal.span (singleton (euclidean_domain.gcd x y)) = ideal.span (insert x (singleton y)) := sorry

-- this should be proved for PIDs?

theorem gcd_is_unit_iff {α : Type u_1} [euclidean_domain α] {x : α} {y : α} : is_unit (euclidean_domain.gcd x y) ↔ is_coprime x y := sorry

-- this should be proved for UFDs surely?

theorem is_coprime_of_dvd {α : Type u_1} [euclidean_domain α] {x : α} {y : α} (z : ¬(x = 0 ∧ y = 0)) (H : ∀ (z : α), z ∈ nonunits α → z ≠ 0 → z ∣ x → ¬z ∣ y) : is_coprime x y := sorry

-- this should be proved for UFDs surely?

theorem dvd_or_coprime {α : Type u_1} [euclidean_domain α] (x : α) (y : α) (h : irreducible x) : x ∣ y ∨ is_coprime x y := sorry


import SciLean.Core
import SciLean.Functions.EpsNorm

namespace SciLean

  variable {X} [Hilbert X]

  def εpow (ε : ℝ) (x : X) (y : ℝ) : ℝ := Math.pow (∥x∥² + ε^2) (y/2)
  argument x [Fact (ε≠0)]
    isSmooth     := sorry,
    diff_simp    := y * ⟪dx, x⟫ * εpow ε x (y-2) by sorry,
    hasAdjDiff   := by constructor; infer_instance; simp; intro; infer_instance; done,
    adjDiff_simp := (y * (dx' * εpow ε x (y-2))) * x by (simp[adjointDifferential]; unfold hold; simp; unfold hold; simp; done)
  -- Defined in EpsLog.lean
  -- argument y [Fact (ε≠0)]
  --   isSmooth := sorry,
  --   diff_simp := dy * (εlog ε x) * εpow ε x y by sorry

  notation  "∥" x "∥^{" y "," ε "}" => εpow ε x y

  @[simp]
  theorem εpow.is_εnorm_at_one (x : X) (ε : ℝ) : ∥x∥^{1,ε} = ∥x∥{ε} := sorry

  @[simp]
  theorem εpow.is_pow_at_zero (x : X) (y : ℝ)  : ∥x∥^{y,0} = ∥x∥^y := sorry

  theorem εpow.is_normSqr_at_two (x : X) (y : ℝ)  : ∥x∥^{(2:ℝ),ε} = ∥x∥² + ε^2 := sorry

  @[simp]
  theorem εpow.recip_εnorm_is_εpow (x : X) (ε : ℝ) (c : ℝ) : c/∥x∥{ε} = c * ∥x∥^{-1,ε} := sorry

  instance εpow.isNonNegative           (x : X) (y : ℝ) : Fact (∥x∥^{y,ε} ≥ 0) := sorry
  instance εpow.isPositive [Fact (ε≠0)] (x : X) (y : ℝ) : Fact (∥x∥^{y,ε} > 0) := sorry

  @[simp]
  theorem εpow.is_pow_of_εnorm (ε : ℝ) [Fact (ε≠0)] (x : X) (y : ℝ) : ∥x∥{ε}^y = ∥x∥^{y,ε} := sorry