import category_theory.category
import category_theory.limits.limits
import category_theory.limits.shapes
import w_pullback

open category_theory
open category_theory.limits

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

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

class internal_category [category.{v} C] [limits.has_limits.{v} C] (obj_obj : C) : Type (max v u) :=
    (obj_arr          : C)
    (i                : obj_obj ⟶ obj_arr)
    (dom              : obj_arr ⟶ obj_obj)
    (cod              : obj_arr ⟶ obj_obj)
    (notation `a2`    := pullback cod dom)
    (comp             : a2 ⟶ obj_arr)
    (notation `π1`    := @pullback.fst _ _ _ _ _ cod dom _)
    (notation `π2`    := @pullback.snd _ _ _ _ _ cod dom _)
    (dom_comp         : comp ≫ dom = π1 ≫ dom)
    (cod_comp         : comp ≫ cod = π2 ≫ cod)
    (dom_i_id         : i ≫ dom = 𝟙 obj_obj)
    (cod_i_id         : i ≫ cod = 𝟙 obj_obj)
    (comp_dom_id      : (pullback.lift (dom ≫ i) (𝟙 obj_arr) (by simp [cod_i_id])) ≫ comp = 𝟙 obj_arr)
    (comp_cod_id      : (pullback.lift (𝟙 obj_arr) (cod ≫ i) (by simp [dom_i_id])) ≫ comp = 𝟙 obj_arr)
    (notation `left`  := @pullback.fst _ _ _ _ _ π2 π1 _)
    (notation `right` := @pullback.snd _ _ _ _ _ π2 π1 _)
    (notation `compl` := pullback.lift (left ≫ comp) (right ≫ π2)
        (begin
            simp [cod_comp, pullback.condition],
            rw category.assoc_symm,
            simp [pullback.condition]
        end))
    (notation `compr` := pullback.lift (left ≫ π1) (right ≫ comp)
        (begin
            simp [dom_comp, pullback.condition],
            rw category.assoc_symm,
            simp [pullback.condition]
        end))
    (comp_compl_compr : compl ≫ comp = compr ≫ comp)

set_option trace.check true

variables {X Y V W Z : C}

lemma pullback_one_eq_f_fst {f : X ⟶ Z} {g : Y ⟶ Z} [has_limit (cospan f g)] :
    (pullback.fst : pullback f g ⟶ X) ≫ f = ((limit.cone (cospan f g)).π).app walking_cospan.one := by apply (limit.w (cospan f g) walking_cospan.hom.inl)

lemma w_pullback_one_eq_f1_fst {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)] :
    (w_pullback.fst : w_pullback f1 g1 f2 g2 ⟶ X) ≫ f1 = ((limit.cone (w_cospan f1 g1 f2 g2)).π).app walking_w.one := by apply (limit.w (w_cospan f1 g1 f2 g2) walking_w.hom.inl1)

lemma w_pullback_two_eq_f2_fst {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)] :
    (w_pullback.mid : w_pullback f1 g1 f2 g2 ⟶ Y) ≫ f2 = ((limit.cone (w_cospan f1 g1 f2 g2)).π).app walking_w.two := by apply (limit.w (w_cospan f1 g1 f2 g2) walking_w.hom.inl2)

lemma pullback_unique_morphism {f : X ⟶ Z} {g : Y ⟶ Z} [has_limit (cospan f g)]
  {h h' : W ⟶ pullback f g} (eq_left : h ≫ pullback.fst = h' ≫ pullback.fst) (eq_right : h ≫ pullback.snd = h' ≫ pullback.snd) : h = h' :=
begin
    apply is_limit.hom_ext,
    apply has_limit.is_limit,
    intros w,
    cases w,
    simp[eq_left],
    simp[eq_right],
    rw ← pullback_one_eq_f_fst,
    rw category.assoc_symm,
    rw category.assoc_symm,
    simp[eq_left]
end

lemma w_pullback_unique_morphism {P X Y V W Z : C} {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)]
  {h h' : P ⟶ w_pullback f1 g1 f2 g2}
  (eq_left : h ≫ w_pullback.fst = h' ≫ w_pullback.fst)
  (eq_mid : h ≫ w_pullback.mid = h' ≫ w_pullback.mid)
  (eq_right : h ≫ w_pullback.snd = h' ≫ w_pullback.snd) :
  h = h' :=
begin
    apply is_limit.hom_ext,
    apply has_limit.is_limit,
    intros w, cases w,
    simp[eq_left],
    simp[eq_mid],
    simp[eq_right],
    rw ← w_pullback_one_eq_f1_fst,
    rw category.assoc_symm,
    rw category.assoc_symm,
    simp[eq_left],
    rw ← w_pullback_two_eq_f2_fst,
    rw category.assoc_symm,
    rw category.assoc_symm,
    simp[eq_mid]
end

lemma pullback.lift_fst {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_limit (cospan f g)] (l : W ⟶ X) (r : W ⟶ Y) (prf : l ≫ f = r ≫ g) :
    (@pullback.lift C _ W X Y Z f g _ l r prf) ≫ pullback.fst = l := begin simp, apply rfl end

lemma pullback.lift_snd {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_limit (cospan f g)] (l : W ⟶ X) (r : W ⟶ Y) (prf : l ≫ f = r ≫ g) :
    (@pullback.lift C _ W X Y Z f g _ l r prf) ≫ pullback.snd = r := begin simp, apply rfl end

lemma w_pullback.lift_fst {P X Y V W Z : C} {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)]
    (h : P ⟶ X) (j : P ⟶ Y) (k : P ⟶ V) (w1 : h ≫ f1 = j ≫ g1) (w2 : j ≫ f2 = k ≫ g2) :
    (@w_pullback.lift C _ P X Y V W Z f1 g1 f2 g2 _ h j k w1 w2) ≫ w_pullback.fst = h := begin simp, apply rfl end

lemma w_pullback.lift_mid {P X Y V W Z : C} {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)]
    (h : P ⟶ X) (j : P ⟶ Y) (k : P ⟶ V) (w1 : h ≫ f1 = j ≫ g1) (w2 : j ≫ f2 = k ≫ g2) :
    (@w_pullback.lift C _ P X Y V W Z f1 g1 f2 g2 _ h j k w1 w2) ≫ w_pullback.mid = j := begin simp, apply rfl end

lemma w_pullback.lift_snd {P X Y V W Z : C} {f1 : X ⟶ W} {g1 : Y ⟶ W} {f2 : Y ⟶ Z} {g2 : V ⟶ Z} [has_limit (w_cospan f1 g1 f2 g2)]
    (h : P ⟶ X) (j : P ⟶ Y) (k : P ⟶ V) (w1 : h ≫ f1 = j ≫ g1) (w2 : j ≫ f2 = k ≫ g2) :
    (@w_pullback.lift C _ P X Y V W Z f1 g1 f2 g2 _ h j k w1 w2) ≫ w_pullback.snd = k := begin simp, apply rfl end

lemma comp_left_cong {a b : X ⟶ Y} {c : Y ⟶ Z} {eq : a = b} : a ≫ c = b ≫ c := begin induction eq, refl end
lemma comp_right_cong {a b : Y ⟶ Z} {c : X ⟶ Y} {eq : a = b} : c ≫ a = c ≫ b := begin induction eq, refl end

abbreviation X₁ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) := w_pullback j iC.dom iC.cod j
abbreviation C₁ {C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] := iC.obj_arr

abbreviation domX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₁ j) ⟶ X₀ := w_pullback.fst
abbreviation codX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₁ j) ⟶ X₀ := w_pullback.snd
abbreviation j₁ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₁ j) ⟶ C₁ := w_pullback.mid

abbreviation X₂ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) := pullback (codX j) (domX j)
abbreviation C₂ {C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] := pullback iC.cod iC.dom

abbreviation πX₁ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₂ j) ⟶ (X₁ j) := pullback.fst
abbreviation πX₂ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₂ j) ⟶ (X₁ j) := pullback.snd
abbreviation j₂ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₂ j) ⟶ C₂ :=
  pullback.lift (pullback.fst ≫ w_pullback.mid) (pullback.snd ≫ w_pullback.mid) (
    begin
        simp[w_pullback.condition2],
        rw ← w_pullback.condition1,
        rw category.assoc_symm,
        rw pullback.condition,
        simp
    end)

abbreviation iX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : X₀ ⟶ (X₁ j) :=
    w_pullback.lift (𝟙 X₀) (j ≫ iC.i) (𝟙 X₀) (by simp[iC.dom_i_id]) (by simp[iC.cod_i_id])

abbreviation C₃ {C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] := pullback (@pullback.snd _ _ _ _ _ iC.cod iC.dom _) (@pullback.snd _ _ _ _ _ iC.cod iC.dom _)

abbreviation X₃ {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) := pullback (πX₂ j) (πX₁ j)

abbreviation compX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₂ j) ⟶ (X₁ j) :=
    @w_pullback.lift _ _ _ _ _ _ _ _ j iC.dom iC.cod j _
        (πX₁ j ≫ domX j)
        ((j₂ j) ≫ iC.comp)
        (πX₂ j ≫ codX j)
        (begin
            simp[w_pullback.condition1],
            rw iC.dom_comp,
            rw category.assoc_symm,
            rw category.assoc_symm,
            apply comp_left_cong,
            rw (pullback.lift_fst iC.cod iC.dom (pullback.fst ≫ w_pullback.mid) (pullback.snd ≫ w_pullback.mid)),
        end)
        (begin
            simp[w_pullback.condition2'],
            rw iC.cod_comp,
            rw category.assoc_symm,
            rw category.assoc_symm,
            apply comp_left_cong,
            rw (pullback.lift_snd iC.cod iC.dom (pullback.fst ≫ w_pullback.mid) (pullback.snd ≫ w_pullback.mid))
        end)

lemma lem_7_4 [has_lim : limits.has_limits.{v} C] {X₀ C₀ : C} [iC : internal_category C₀] (j : X₀ ⟶ C₀)
    {T U : C} {f₁ f₂ : T ⟶ X₁ j} {f₁' f₂' : U ⟶ C₁}
    {k : T ⟶ U}
    (dom_cod_X : f₁ ≫ codX j = f₂ ≫ domX j)
    (dom_cod_C : f₁' ≫ iC.cod = f₂' ≫ iC.dom)
    (j_f_1 : f₁ ≫ j₁ j = k ≫ f₁')
    (j_f_2 : f₂ ≫ j₁ j = k ≫ f₂') :
    k ≫ (pullback.lift f₁' f₂' dom_cod_C) = (pullback.lift f₁ f₂ dom_cod_X) ≫ j₂ j :=
begin
    apply pullback_unique_morphism,
    rw ← category.assoc_symm,
    rw pullback.lift_fst,
    rw ← j_f_1,
    rw ← category.assoc_symm,
    rw pullback.lift_fst,
    rw category.assoc_symm,
    rw pullback.lift_fst,

    rw ← category.assoc_symm,
    rw pullback.lift_snd,
    rw ← j_f_2,
    rw ← category.assoc_symm,
    rw pullback.lift_snd,
    rw category.assoc_symm,
    rw pullback.lift_snd
end

abbreviation complX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₃ j) ⟶ (X₂ j) :=
    pullback.lift (pullback.fst ≫ compX j) (pullback.snd ≫ πX₂ j)
        (begin
            rw ← category.assoc_symm,
            rw w_pullback.lift_snd,
            rw category.assoc_symm,
            simp [pullback.condition]
        end)

abbreviation comprX {X₀ C₀ : C} [limits.has_limits.{v} C] [iC : internal_category C₀] (j : X₀ ⟶ C₀) : (X₃ j) ⟶ (X₂ j) :=
    pullback.lift (pullback.fst ≫ πX₁ j) (pullback.snd ≫ compX j)
        (begin
            symmetry,
            rw ← category.assoc_symm,
            rw w_pullback.lift_fst,
            rw category.assoc_symm,
            rw ← pullback.condition,
            rw ← category.assoc_symm,
            rw ← category.assoc_symm,
            apply comp_right_cong,
            simp [pullback.condition]
        end)

lemma lem_7_6 [has_lim : limits.has_limits.{v} C] {X₀ C₀ : C} [iC : internal_category C₀] (j : X₀ ⟶ C₀) :
    complX j ≫ compX j = comprX j ≫ compX j :=
begin
    apply w_pullback_unique_morphism,
        -- dom𝕏 ⚬ comp𝕏 ⚬ compl𝕏 = dom𝕏 ⚬ comp𝕏 ⚬ compr𝕏
        rw ← category.assoc_symm,
        rw w_pullback.lift_fst,
        rw category.assoc_symm,
        rw pullback.lift_fst,
        rw ← category.assoc_symm,
        rw w_pullback.lift_fst,
        rw ← category.assoc_symm,
        rw w_pullback.lift_fst,
        rw category.assoc_symm,
        rw category.assoc_symm,
        simp [pullback.lift_fst],
        -- j₁ ⚬ comp𝕏 ⚬ compl𝕏 = j₁ ⚬ comp𝕏 ⚬ compr𝕏
        rw ← category.assoc_symm,
        rw w_pullback.lift_mid,
        rw ← category.assoc_symm,
        rw w_pullback.lift_mid,
        rw category.assoc_symm,
        rw category.assoc_symm,
            transitivity pullback.lift (pullback.fst ≫ j₂ j) (pullback.snd ≫ j₂ j) _ ≫ _ ≫ iC.comp,
            rw category.assoc_symm,
            apply comp_left_cong,
            symmetry,
            apply (@lem_7_4 _ _ _ _ _ _ j _ _ (pullback.fst ≫ compX j) (pullback.snd ≫ πX₂ j) (pullback.fst ≫ iC.comp) ((@pullback.snd _ _ _ _ _ pullback.snd pullback.fst _) ≫ @pullback.snd _ _ _ _ _ iC.cod iC.dom _)),

                rw ← category.assoc_symm,
                rw iC.cod_comp,
                rw ← category.assoc_symm,
                rw ← pullback.condition,
                rw category.assoc_symm,
                simp[pullback.condition],

                rw ← category.assoc_symm,
                rw w_pullback.lift_mid,
                rw category.assoc_symm,
                rw category.assoc_symm,
                apply comp_left_cong,
                simp[pullback.lift_fst],

                rw category.assoc_symm,
                rw pullback.lift_snd,
                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                rw pullback.lift_snd,

                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                rw pullback.lift_snd,
                rw pullback.lift_fst,
                rw category.assoc_symm,
                rw category.assoc_symm,
                simp[pullback.condition],

            symmetry,
            transitivity (pullback.lift (pullback.fst ≫ j₂ j) (pullback.snd ≫ j₂ j) _ ≫ _) ≫ iC.comp,
            apply comp_left_cong,
            symmetry,
            apply (@lem_7_4 _ _ _ _ _ _ j _ _ (pullback.fst ≫ πX₁ j) (pullback.snd ≫ compX j) ((@pullback.fst _ _ _ _ _ pullback.snd pullback.fst _) ≫ @pullback.fst _ _ _ _ _ iC.cod iC.dom _) (pullback.snd ≫ iC.comp) ),

                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                rw iC.dom_comp,
                rw pullback.condition,
                rw category.assoc_symm,
                simp[pullback.condition],

                rw category.assoc_symm,
                rw pullback.lift_fst,
                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                apply comp_right_cong,
                simp[pullback.lift_fst],

                rw category.assoc_symm,
                rw pullback.lift_snd,
                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                rw w_pullback.lift_mid,

                rw ← category.assoc_symm,
                rw ← category.assoc_symm,
                rw pullback.lift_snd,
                rw pullback.lift_fst,
                rw category.assoc_symm,
                rw category.assoc_symm,
                simp[pullback.condition],

            rw ← category.assoc_symm,
            apply comp_right_cong,
            rw iC.comp_compl_compr,
        -- cod𝕏 ⚬ comp𝕏 ⚬ compl𝕏 = cod𝕏 ⚬ comp𝕏 ⚬ compr𝕏
        rw ← category.assoc_symm,
        rw w_pullback.lift_snd,
        rw category.assoc_symm,
        rw pullback.lift_snd,
        rw ← category.assoc_symm,
        rw ← category.assoc_symm,
        rw w_pullback.lift_snd,
        rw category.assoc_symm,
        rw category.assoc_symm,
        rw pullback.lift_snd,
        rw ← category.assoc_symm,
        rw ← category.assoc_symm,
        rw w_pullback.lift_snd
end

def pulled_back_of_internal_category [has_lim : limits.has_limits.{v} C] (obj_obj X : C) [iC : internal_category obj_obj] (j : X ⟶ obj_obj) :
  internal_category X := {
      obj_arr := X₁ j ,
      dom := domX j,
      cod := codX j,
      comp := w_pullback.lift
        (πX₁ j ≫ domX j)
        ((j₂ j) ≫ iC.comp)
        (πX₂ j ≫ codX j)
        (begin
            simp[w_pullback.condition1],
            rw iC.dom_comp,
            rw category.assoc_symm,
            rw category.assoc_symm,
            apply comp_left_cong,
            rw (pullback.lift_fst iC.cod iC.dom (pullback.fst ≫ w_pullback.mid) (pullback.snd ≫ w_pullback.mid)),
        end)
        (begin
            simp[w_pullback.condition2'],
            rw iC.cod_comp,
            rw category.assoc_symm,
            rw category.assoc_symm,
            apply comp_left_cong,
            rw (pullback.lift_snd iC.cod iC.dom (pullback.fst ≫ w_pullback.mid) (pullback.snd ≫ w_pullback.mid))
        end),
      i := iX j,
      dom_comp := by simp[w_pullback.lift_fst],
      cod_comp := by simp[w_pullback.lift_snd],
      dom_i_id := by simp[w_pullback.lift_fst],
      cod_i_id := by simp[w_pullback.lift_snd],
      comp_dom_id := begin
          apply w_pullback_unique_morphism,
          work_on_goal 2 {
              rw ← category.assoc_symm,
              rw (w_pullback.lift_snd _ _ (pullback.snd ≫ w_pullback.snd)),
              rw category.assoc_symm,
              rw pullback.lift_snd
          },
          work_on_goal 0 {
              rw ← category.assoc_symm,
              rw w_pullback.lift_fst,
              rw category.assoc_symm,
              rw pullback.lift_fst,
              rw ← category.assoc_symm,
              rw w_pullback.lift_fst,
              simp
          },
          rw ← category.assoc_symm,
          rw w_pullback.lift_mid,
          rw category.assoc_symm,
          transitivity (j₁ j ≫ pullback.lift (iC.dom ≫ iC.i) (𝟙 C₁) _) ≫ iC.comp,
          apply comp_left_cong,
          symmetry,
          apply lem_7_4,
          rw ← category.assoc_symm,
          rw w_pullback.lift_mid,
          rw category.assoc_symm,
          simp [w_pullback.condition1],
          simp,
          rw ← category.assoc_symm,
          simp[iC.cod_i_id],
          rw ← category.assoc_symm,
          simp[iC.comp_dom_id]
       end,
      comp_cod_id := begin
          apply w_pullback_unique_morphism,
          work_on_goal 2 {
              rw ← category.assoc_symm,
              rw (w_pullback.lift_snd _ _ (pullback.snd ≫ w_pullback.snd)),
              rw category.assoc_symm,
              rw pullback.lift_snd,
              simp[w_pullback.lift_snd]
          },
          work_on_goal 0 {
              rw ← category.assoc_symm,
              rw (w_pullback.lift_fst _ _ (pullback.snd ≫ w_pullback.snd)),
              rw category.assoc_symm,
              rw pullback.lift_fst
          },
          rw ← category.assoc_symm,
          rw w_pullback.lift_mid,
          rw category.assoc_symm,
          transitivity (j₁ j ≫ pullback.lift (𝟙 C₁) (iC.cod ≫ iC.i) _) ≫ iC.comp,
          apply comp_left_cong,
          symmetry,
          apply lem_7_4,
          simp,
          rw ← category.assoc_symm,
          rw w_pullback.lift_mid,
          rw category.assoc_symm,
          simp [w_pullback.condition2'],
          rw ← category.assoc_symm,
          simp[iC.dom_i_id],
          rw ← category.assoc_symm,
          simp[iC.comp_cod_id]
       end,
    comp_compl_compr := by apply (lem_7_6 j)
  }


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

! This file was ported from Lean 3 source module ring_theory.localization.norm
! leanprover-community/mathlib commit 2e59a6de168f95d16b16d217b808a36290398c0a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.Module
import Mathbin.RingTheory.Norm

/-!

# Field/algebra norm and localization

This file contains results on the combination of `algebra.norm` and `is_localization`.

## Main results

 * `algebra.norm_localization`: let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M`
  of `R S` respectively. Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R`
  if `S` is free as `R`-module

## Tags

field norm, algebra norm, localization

-/

open nonZeroDivisors

variable (R : Type _) {S : Type _} [CommRing R] [CommRing S] [Algebra R S]

variable {Rₘ Sₘ : Type _} [CommRing Rₘ] [Algebra R Rₘ] [CommRing Sₘ] [Algebra S Sₘ]

variable (M : Submonoid R)

variable [IsLocalization M Rₘ] [IsLocalization (Algebra.algebraMapSubmonoid S M) Sₘ]

variable [Algebra Rₘ Sₘ] [Algebra R Sₘ] [IsScalarTower R Rₘ Sₘ] [IsScalarTower R S Sₘ]

include M

/-- Let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M` of `R S` respectively.
Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R` if `S` is free as `R`-module.
-/
theorem Algebra.norm_localization [Module.Free R S] [Module.Finite R S] (a : S) :
    Algebra.norm Rₘ (algebraMap S Sₘ a) = algebraMap R Rₘ (Algebra.norm R a) :=
  by
  cases subsingleton_or_nontrivial R
  · haveI : Subsingleton Rₘ := Module.subsingleton R Rₘ
    simp
  let b := Module.Free.chooseBasis R S
  letI := Classical.decEq (Module.Free.ChooseBasisIndex R S)
  rw [Algebra.norm_eq_matrix_det (b.localization_localization Rₘ M Sₘ),
    Algebra.norm_eq_matrix_det b, RingHom.map_det]
  congr
  ext (i j)
  simp only [Matrix.map_apply, RingHom.mapMatrix_apply, Algebra.leftMulMatrix_eq_repr_mul,
    Basis.localizationLocalization_apply, ← _root_.map_mul]
  apply Basis.localizationLocalization_repr_algebraMap
#align algebra.norm_localization Algebra.norm_localization


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

import category_theory.epi_mono
import category_theory.limits.shapes.finite_products
import category_theory.monoidal.of_has_finite_products
import category_theory.limits.preserves.shapes.binary_products
import category_theory.adjunction.limits
import category_theory.adjunction.mates
import category_theory.closed.monoidal

/-!
# Cartesian closed categories

Given a category with finite products, the cartesian monoidal structure is provided by the local
instance `monoidal_of_has_finite_products`.

We define exponentiable objects to be closed objects with respect to this monoidal structure,
i.e. `(X × -)` is a left adjoint.

We say a category is cartesian closed if every object is exponentiable
(equivalently, that the category equipped with the cartesian monoidal structure is closed monoidal).

Show that exponential forms a difunctor and define the exponential comparison morphisms.

## TODO
Some of the results here are true more generally for closed objects and
for closed monoidal categories, and these could be generalised.
-/
universes v u u₂

noncomputable theory

namespace category_theory

open category_theory category_theory.category category_theory.limits

local attribute [instance] monoidal_of_has_finite_products

/--
An object `X` is *exponentiable* if `(X × -)` is a left adjoint.
We define this as being `closed` in the cartesian monoidal structure.
-/
abbreviation exponentiable {C : Type u} [category.{v} C] [has_finite_products C] (X : C) :=
closed X

/--
If `X` and `Y` are exponentiable then `X ⨯ Y` is.
This isn't an instance because it's not usually how we want to construct exponentials, we'll usually
prove all objects are exponential uniformly.
-/
def binary_product_exponentiable {C : Type u} [category.{v} C] [has_finite_products C] {X Y : C}
  (hX : exponentiable X) (hY : exponentiable Y) : exponentiable (X ⨯ Y) :=
tensor_closed hX hY

/--
The terminal object is always exponentiable.
This isn't an instance because most of the time we'll prove cartesian closed for all objects
at once, rather than just for this one.
-/
def terminal_exponentiable {C : Type u} [category.{v} C] [has_finite_products C] :
  exponentiable ⊤_ C :=
unit_closed

/--
A category `C` is cartesian closed if it has finite products and every object is exponentiable.
We define this as `monoidal_closed` with respect to the cartesian monoidal structure.
-/
abbreviation cartesian_closed (C : Type u) [category.{v} C] [has_finite_products C] :=
monoidal_closed C

variables {C : Type u} [category.{v} C] (A B : C) {X X' Y Y' Z : C}

variables [has_finite_products C] [exponentiable A]

/-- This is (-)^A. -/
abbreviation exp : C ⥤ C :=
ihom A

namespace exp

/-- The adjunction between A ⨯ - and (-)^A. -/
abbreviation adjunction : prod.functor.obj A ⊣ exp A :=
ihom.adjunction A

/-- The evaluation natural transformation. -/
abbreviation ev : exp A ⋙ prod.functor.obj A ⟶ 𝟭 C :=
ihom.ev A

/-- The coevaluation natural transformation. -/
abbreviation coev : 𝟭 C ⟶ prod.functor.obj A ⋙ exp A :=
ihom.coev A

notation A ` ⟹ `:20 B:19 := (exp A).obj B
notation B ` ^^ `:30 A:30 := (exp A).obj B

@[simp, reassoc] lemma ev_coev :
  limits.prod.map (𝟙 A) ((coev A).app B) ≫ (ev A).app (A ⨯ B) = 𝟙 (A ⨯ B) :=
ihom.ev_coev A B

@[simp, reassoc] lemma coev_ev : (coev A).app (A ⟹ B) ≫ (exp A).map ((ev A).app B) = 𝟙 (A ⟹ B) :=
ihom.coev_ev A B

end exp

instance : preserves_colimits (prod.functor.obj A) :=
(ihom.adjunction A).left_adjoint_preserves_colimits

variables {A}

-- Wrap these in a namespace so we don't clash with the core versions.
namespace cartesian_closed

/-- Currying in a cartesian closed category. -/
def curry : (A ⨯ Y ⟶ X) → (Y ⟶ A ⟹ X) :=
(exp.adjunction A).hom_equiv _ _
/-- Uncurrying in a cartesian closed category. -/
def uncurry : (Y ⟶ A ⟹ X) → (A ⨯ Y ⟶ X) :=
((exp.adjunction A).hom_equiv _ _).symm

@[simp] lemma hom_equiv_apply_eq (f : A ⨯ Y ⟶ X) :
  (exp.adjunction A).hom_equiv _ _ f = curry f := rfl
@[simp] lemma hom_equiv_symm_apply_eq (f : Y ⟶ A ⟹ X) :
  ((exp.adjunction A).hom_equiv _ _).symm f = uncurry f := rfl

@[reassoc]
lemma curry_natural_left (f : X ⟶ X') (g : A ⨯ X' ⟶ Y) :
  curry (limits.prod.map (𝟙 _) f ≫ g) = f ≫ curry g :=
adjunction.hom_equiv_naturality_left _ _ _

@[reassoc]
lemma curry_natural_right (f : A ⨯ X ⟶ Y) (g : Y ⟶ Y') :
  curry (f ≫ g) = curry f ≫ (exp _).map g :=
adjunction.hom_equiv_naturality_right _ _ _

@[reassoc]
lemma uncurry_natural_right  (f : X ⟶ A⟹Y) (g : Y ⟶ Y') :
  uncurry (f ≫ (exp _).map g) = uncurry f ≫ g :=
adjunction.hom_equiv_naturality_right_symm _ _ _

@[reassoc]
lemma uncurry_natural_left  (f : X ⟶ X') (g : X' ⟶ A⟹Y) :
  uncurry (f ≫ g) = limits.prod.map (𝟙 _) f ≫ uncurry g :=
adjunction.hom_equiv_naturality_left_symm _ _ _

@[simp]
lemma uncurry_curry (f : A ⨯ X ⟶ Y) : uncurry (curry f) = f :=
(closed.is_adj.adj.hom_equiv _ _).left_inv f

@[simp]
lemma curry_uncurry (f : X ⟶ A⟹Y) : curry (uncurry f) = f :=
(closed.is_adj.adj.hom_equiv _ _).right_inv f

lemma curry_eq_iff (f : A ⨯ Y ⟶ X) (g : Y ⟶ A ⟹ X) :
  curry f = g ↔ f = uncurry g :=
adjunction.hom_equiv_apply_eq _ f g

lemma eq_curry_iff (f : A ⨯ Y ⟶ X) (g : Y ⟶ A ⟹ X) :
  g = curry f ↔ uncurry g = f :=
adjunction.eq_hom_equiv_apply _ f g

-- I don't think these two should be simp.
lemma uncurry_eq (g : Y ⟶ A ⟹ X) : uncurry g = limits.prod.map (𝟙 A) g ≫ (exp.ev A).app X :=
adjunction.hom_equiv_counit _

lemma curry_eq (g : A ⨯ Y ⟶ X) : curry g = (exp.coev A).app Y ≫ (exp A).map g :=
adjunction.hom_equiv_unit _

lemma uncurry_id_eq_ev (A X : C) [exponentiable A] : uncurry (𝟙 (A ⟹ X)) = (exp.ev A).app X :=
by rw [uncurry_eq, prod.map_id_id, id_comp]

lemma curry_id_eq_coev (A X : C) [exponentiable A] : curry (𝟙 _) = (exp.coev A).app X :=
by { rw [curry_eq, (exp A).map_id (A ⨯ _)], apply comp_id }

lemma curry_injective : function.injective (curry : (A ⨯ Y ⟶ X) → (Y ⟶ A ⟹ X)) :=
(closed.is_adj.adj.hom_equiv _ _).injective

lemma uncurry_injective : function.injective (uncurry : (Y ⟶ A ⟹ X) → (A ⨯ Y ⟶ X)) :=
(closed.is_adj.adj.hom_equiv _ _).symm.injective

end cartesian_closed

open cartesian_closed

/--
Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def exp_terminal_iso_self [exponentiable ⊤_ C] : (⊤_ C ⟹ X) ≅ X :=
yoneda.ext (⊤_ C ⟹ X) X
  (λ Y f, (prod.left_unitor Y).inv ≫ cartesian_closed.uncurry f)
  (λ Y f, cartesian_closed.curry ((prod.left_unitor Y).hom ≫ f))
  (λ Z g, by rw [curry_eq_iff, iso.hom_inv_id_assoc] )
  (λ Z g, by simp)
  (λ Z W f g, by rw [uncurry_natural_left, prod.left_unitor_inv_naturality_assoc f] )

/-- The internal element which points at the given morphism. -/
def internalize_hom (f : A ⟶ Y) : ⊤_ C ⟶ (A ⟹ Y) :=
cartesian_closed.curry (limits.prod.fst ≫ f)

section pre

variables {B}

/-- Pre-compose an internal hom with an external hom. -/
def pre (f : B ⟶ A) [exponentiable B] : exp A ⟶ exp B :=
transfer_nat_trans_self (exp.adjunction _) (exp.adjunction _) (prod.functor.map f)

lemma prod_map_pre_app_comp_ev (f : B ⟶ A) [exponentiable B] (X : C) :
  limits.prod.map (𝟙 B) ((pre f).app X) ≫ (exp.ev B).app X =
    limits.prod.map f (𝟙 (A ⟹ X)) ≫ (exp.ev A).app X :=
transfer_nat_trans_self_counit _ _ (prod.functor.map f) X

lemma uncurry_pre (f : B ⟶ A) [exponentiable B] (X : C) :
  cartesian_closed.uncurry ((pre f).app X) = limits.prod.map f (𝟙 _) ≫ (exp.ev A).app X :=
begin
  rw [uncurry_eq, prod_map_pre_app_comp_ev]
end

lemma coev_app_comp_pre_app (f : B ⟶ A) [exponentiable B] :
  (exp.coev A).app X ≫ (pre f).app (A ⨯ X) =
    (exp.coev B).app X ≫ (exp B).map (limits.prod.map f (𝟙 _)) :=
unit_transfer_nat_trans_self _ _ (prod.functor.map f) X

@[simp]
lemma pre_id (A : C) [exponentiable A] : pre (𝟙 A) = 𝟙 _ :=
by simp [pre]

@[simp]
lemma pre_map {A₁ A₂ A₃ : C} [exponentiable A₁] [exponentiable A₂] [exponentiable A₃]
  (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃) :
  pre (f ≫ g) = pre g ≫ pre f :=
by rw [pre, pre, pre, transfer_nat_trans_self_comp, prod.functor.map_comp]

end pre

/-- The internal hom functor given by the cartesian closed structure. -/
def internal_hom [cartesian_closed C] : Cᵒᵖ ⥤ C ⥤ C :=
{ obj := λ X, exp X.unop,
  map := λ X Y f, pre f.unop }

/-- If an initial object `I` exists in a CCC, then `A ⨯ I ≅ I`. -/
@[simps]
def zero_mul {I : C} (t : is_initial I) : A ⨯ I ≅ I :=
{ hom := limits.prod.snd,
  inv := t.to _,
  hom_inv_id' :=
  begin
    have: (limits.prod.snd : A ⨯ I ⟶ I) = cartesian_closed.uncurry (t.to _),
      rw ← curry_eq_iff,
      apply t.hom_ext,
    rw [this, ← uncurry_natural_right, ← eq_curry_iff],
    apply t.hom_ext,
  end,
  inv_hom_id' := t.hom_ext _ _ }

/-- If an initial object `0` exists in a CCC, then `0 ⨯ A ≅ 0`. -/
def mul_zero {I : C} (t : is_initial I) : I ⨯ A ≅ I :=
limits.prod.braiding _ _ ≪≫ zero_mul t

/-- If an initial object `0` exists in a CCC then `0^B ≅ 1` for any `B`. -/
def pow_zero {I : C} (t : is_initial I) [cartesian_closed C] : I ⟹ B ≅ ⊤_ C :=
{ hom := default,
  inv := cartesian_closed.curry ((mul_zero t).hom ≫ t.to _),
  hom_inv_id' :=
  begin
    rw [← curry_natural_left, curry_eq_iff, ← cancel_epi (mul_zero t).inv],
    { apply t.hom_ext },
    { apply_instance },
    { apply_instance },
  end }

-- TODO: Generalise the below to its commutated variants.
-- TODO: Define a distributive category, so that zero_mul and friends can be derived from this.
/-- In a CCC with binary coproducts, the distribution morphism is an isomorphism. -/
def prod_coprod_distrib [has_binary_coproducts C] [cartesian_closed C] (X Y Z : C) :
  (Z ⨯ X) ⨿ (Z ⨯ Y) ≅ Z ⨯ (X ⨿ Y) :=
{ hom := coprod.desc (limits.prod.map (𝟙 _) coprod.inl) (limits.prod.map (𝟙 _) coprod.inr),
  inv := cartesian_closed.uncurry
    (coprod.desc (cartesian_closed.curry coprod.inl) (cartesian_closed.curry coprod.inr)),
  hom_inv_id' :=
  begin
    apply coprod.hom_ext,
    rw [coprod.inl_desc_assoc, comp_id, ←uncurry_natural_left, coprod.inl_desc, uncurry_curry],
    rw [coprod.inr_desc_assoc, comp_id, ←uncurry_natural_left, coprod.inr_desc, uncurry_curry],
  end,
  inv_hom_id' :=
  begin
    rw [← uncurry_natural_right, ←eq_curry_iff],
    apply coprod.hom_ext,
    rw [coprod.inl_desc_assoc, ←curry_natural_right, coprod.inl_desc, ←curry_natural_left, comp_id],
    rw [coprod.inr_desc_assoc, ←curry_natural_right, coprod.inr_desc, ←curry_natural_left, comp_id],
  end }

/--
If an initial object `I` exists in a CCC then it is a strict initial object,
i.e. any morphism to `I` is an iso.
This actually shows a slightly stronger version: any morphism to an initial object from an
exponentiable object is an isomorphism.
-/
lemma strict_initial {I : C} (t : is_initial I) (f : A ⟶ I) : is_iso f :=
begin
  haveI : mono (limits.prod.lift (𝟙 A) f ≫ (zero_mul t).hom) := mono_comp _ _,
  rw [zero_mul_hom, prod.lift_snd] at _inst,
  haveI: is_split_epi f := is_split_epi.mk' ⟨t.to _, t.hom_ext _ _⟩,
  apply is_iso_of_mono_of_is_split_epi
end

instance to_initial_is_iso [has_initial C] (f : A ⟶ ⊥_ C) : is_iso f :=
strict_initial initial_is_initial _

/-- If an initial object `0` exists in a CCC then every morphism from it is monic. -/
lemma initial_mono {I : C} (B : C) (t : is_initial I) [cartesian_closed C] : mono (t.to B) :=
⟨λ B g h _,
begin
  haveI := strict_initial t g,
  haveI := strict_initial t h,
  exact eq_of_inv_eq_inv (t.hom_ext _ _)
end⟩

instance initial.mono_to [has_initial C] (B : C) [cartesian_closed C] : mono (initial.to B) :=
initial_mono B initial_is_initial

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

variables [has_finite_products D]

/--
Transport the property of being cartesian closed across an equivalence of categories.

Note we didn't require any coherence between the choice of finite products here, since we transport
along the `prod_comparison` isomorphism.
-/
def cartesian_closed_of_equiv (e : C ≌ D) [h : cartesian_closed C] : cartesian_closed D :=
{ closed' := λ X,
  { is_adj :=
    begin
      haveI q : exponentiable (e.inverse.obj X) := infer_instance,
      have : is_left_adjoint (prod.functor.obj (e.inverse.obj X)) := q.is_adj,
      have : e.functor ⋙ prod.functor.obj X ⋙ e.inverse ≅ prod.functor.obj (e.inverse.obj X),
      apply nat_iso.of_components _ _,
      intro Y,
      { apply as_iso (prod_comparison e.inverse X (e.functor.obj Y)) ≪≫ _,
        apply prod.map_iso (iso.refl _) (e.unit_iso.app Y).symm },
      { intros Y Z g,
        dsimp [prod_comparison],
        simp [prod.comp_lift, ← e.inverse.map_comp, ← e.inverse.map_comp_assoc],
          -- I wonder if it would be a good idea to make `map_comp` a simp lemma the other way round
        dsimp, simp }, -- See note [dsimp, simp]
      { have : is_left_adjoint (e.functor ⋙ prod.functor.obj X ⋙ e.inverse) :=
          by exactI adjunction.left_adjoint_of_nat_iso this.symm,
        have : is_left_adjoint (e.inverse ⋙ e.functor ⋙ prod.functor.obj X ⋙ e.inverse) :=
          by exactI adjunction.left_adjoint_of_comp e.inverse _,
        have : (e.inverse ⋙ e.functor ⋙ prod.functor.obj X ⋙ e.inverse) ⋙ e.functor ≅
          prod.functor.obj X,
        { apply iso_whisker_right e.counit_iso (prod.functor.obj X ⋙ e.inverse ⋙ e.functor) ≪≫ _,
          change prod.functor.obj X ⋙ e.inverse ⋙ e.functor ≅ prod.functor.obj X,
          apply iso_whisker_left (prod.functor.obj X) e.counit_iso, },
        resetI,
        apply adjunction.left_adjoint_of_nat_iso this },
    end } }

end functor

end category_theory


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Order for Rational Numbers

## Summary

We define the order on `ℚ`, prove that `ℚ` is a discrete, linearly ordered field, and define
functions such as `abs` and `sqrt` that depend on this order.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom, order, ordering, sqrt, abs
-/

namespace rat

protected def nonneg : ℚ → Prop :=
  sorry

@[simp] theorem mk_nonneg (a : ℤ) {b : ℤ} (h : 0 < b) : rat.nonneg (mk a b) ↔ 0 ≤ a := sorry

protected theorem nonneg_add {a : ℚ} {b : ℚ} : rat.nonneg a → rat.nonneg b → rat.nonneg (a + b) := sorry

protected theorem nonneg_mul {a : ℚ} {b : ℚ} : rat.nonneg a → rat.nonneg b → rat.nonneg (a * b) := sorry

protected theorem nonneg_antisymm {a : ℚ} : rat.nonneg a → rat.nonneg (-a) → a = 0 := sorry

protected theorem nonneg_total (a : ℚ) : rat.nonneg a ∨ rat.nonneg (-a) :=
  cases_on a
    fun (n : ℤ) (a_denom : ℕ) (a_pos : 0 < a_denom) (a_cop : nat.coprime (int.nat_abs n) a_denom) =>
      or.imp_right neg_nonneg_of_nonpos (le_total 0 n)

protected instance decidable_nonneg (a : ℚ) : Decidable (rat.nonneg a) :=
  cases_on a
    fun (a_num : ℤ) (a_denom : ℕ) (a_pos : 0 < a_denom) (a_cop : nat.coprime (int.nat_abs a_num) a_denom) =>
      eq.mpr sorry (int.decidable_le 0 a_num)

protected def le (a : ℚ) (b : ℚ) :=
  rat.nonneg (b - a)

protected instance has_le : HasLessEq ℚ :=
  { LessEq := rat.le }

protected instance decidable_le : DecidableRel LessEq :=
  sorry

protected theorem le_def {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (b0 : 0 < b) (d0 : 0 < d) : mk a b ≤ mk c d ↔ a * d ≤ c * b := sorry

protected theorem le_refl (a : ℚ) : a ≤ a :=
  (fun (this : rat.nonneg (a - a)) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (rat.nonneg (a - a))) (sub_self a))) (le_refl 0))

protected theorem le_total (a : ℚ) (b : ℚ) : a ≤ b ∨ b ≤ a :=
  eq.mp (Eq._oldrec (Eq.refl (rat.nonneg (b - a) ∨ rat.nonneg (-(b - a)))) (neg_sub b a)) (rat.nonneg_total (b - a))

protected theorem le_antisymm {a : ℚ} {b : ℚ} (hab : a ≤ b) (hba : b ≤ a) : a = b := sorry

protected theorem le_trans {a : ℚ} {b : ℚ} {c : ℚ} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c := sorry

protected instance linear_order : linear_order ℚ :=
  linear_order.mk rat.le (partial_order.lt._default rat.le) rat.le_refl rat.le_trans rat.le_antisymm rat.le_total
    (fun (a b : ℚ) => rat.decidable_nonneg (b - a)) (fun (a b : ℚ) => rat.decidable_eq a b)
    Mathlib.decidable_lt_of_decidable_le

/- Extra instances to short-circuit type class resolution -/

protected instance has_lt : HasLess ℚ :=
  preorder.to_has_lt ℚ

protected instance distrib_lattice : distrib_lattice ℚ :=
  Mathlib.distrib_lattice_of_linear_order

protected instance lattice : lattice ℚ :=
  Mathlib.lattice_of_linear_order

protected instance semilattice_inf : semilattice_inf ℚ :=
  lattice.to_semilattice_inf ℚ

protected instance semilattice_sup : semilattice_sup ℚ :=
  lattice.to_semilattice_sup ℚ

protected instance has_inf : has_inf ℚ :=
  semilattice_inf.to_has_inf ℚ

protected instance has_sup : has_sup ℚ :=
  semilattice_sup.to_has_sup ℚ

protected instance partial_order : partial_order ℚ :=
  semilattice_inf.to_partial_order ℚ

protected instance preorder : preorder ℚ :=
  directed_order.to_preorder

protected theorem le_def' {p : ℚ} {q : ℚ} : p ≤ q ↔ num p * ↑(denom q) ≤ num q * ↑(denom p) := sorry

protected theorem lt_def {p : ℚ} {q : ℚ} : p < q ↔ num p * ↑(denom q) < num q * ↑(denom p) := sorry

theorem nonneg_iff_zero_le {a : ℚ} : rat.nonneg a ↔ 0 ≤ a := sorry

theorem num_nonneg_iff_zero_le {a : ℚ} : 0 ≤ num a ↔ 0 ≤ a :=
  cases_on a
    fun (a_num : ℤ) (a_denom : ℕ) (a_pos : 0 < a_denom) (a_cop : nat.coprime (int.nat_abs a_num) a_denom) =>
      idRhs (rat.nonneg (mk' a_num a_denom a_pos a_cop) ↔ 0 ≤ mk' a_num a_denom a_pos a_cop) nonneg_iff_zero_le

protected theorem add_le_add_left {a : ℚ} {b : ℚ} {c : ℚ} : c + a ≤ c + b ↔ a ≤ b := sorry

protected theorem mul_nonneg {a : ℚ} {b : ℚ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ a * b)) (Eq.symm (propext nonneg_iff_zero_le))))
    (rat.nonneg_mul (eq.mp (Eq._oldrec (Eq.refl (0 ≤ a)) (Eq.symm (propext nonneg_iff_zero_le))) ha)
      (eq.mp (Eq._oldrec (Eq.refl (0 ≤ b)) (Eq.symm (propext nonneg_iff_zero_le))) hb))

protected instance linear_ordered_field : linear_ordered_field ℚ :=
  linear_ordered_field.mk field.add field.add_assoc field.zero field.zero_add field.add_zero field.neg field.sub
    field.add_left_neg field.add_comm field.mul field.mul_assoc field.one field.one_mul field.mul_one field.left_distrib
    field.right_distrib linear_order.le linear_order.lt linear_order.le_refl linear_order.le_trans
    linear_order.le_antisymm sorry sorry sorry linear_order.le_total linear_order.decidable_le linear_order.decidable_eq
    linear_order.decidable_lt field.exists_pair_ne field.mul_comm field.inv field.mul_inv_cancel field.inv_zero

/- Extra instances to short-circuit type class resolution -/

protected instance linear_ordered_comm_ring : linear_ordered_comm_ring ℚ :=
  linear_ordered_field.to_linear_ordered_comm_ring ℚ

protected instance linear_ordered_ring : linear_ordered_ring ℚ :=
  linear_ordered_comm_ring.to_linear_ordered_ring ℚ

protected instance ordered_ring : ordered_ring ℚ :=
  linear_ordered_ring.to_ordered_ring ℚ

protected instance linear_ordered_semiring : linear_ordered_semiring ℚ :=
  linear_ordered_comm_ring.to_linear_ordered_semiring

protected instance ordered_semiring : ordered_semiring ℚ :=
  ordered_ring.to_ordered_semiring

protected instance linear_ordered_add_comm_group : linear_ordered_add_comm_group ℚ :=
  linear_ordered_ring.to_linear_ordered_add_comm_group

protected instance ordered_add_comm_group : ordered_add_comm_group ℚ :=
  ordered_ring.to_ordered_add_comm_group ℚ

protected instance ordered_cancel_add_comm_monoid : ordered_cancel_add_comm_monoid ℚ :=
  ordered_semiring.to_ordered_cancel_add_comm_monoid ℚ

protected instance ordered_add_comm_monoid : ordered_add_comm_monoid ℚ :=
  ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid

theorem num_pos_iff_pos {a : ℚ} : 0 < num a ↔ 0 < a := sorry

theorem div_lt_div_iff_mul_lt_mul {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (b_pos : 0 < b) (d_pos : 0 < d) : ↑a / ↑b < ↑c / ↑d ↔ a * d < c * b := sorry

theorem lt_one_iff_num_lt_denom {q : ℚ} : q < 1 ↔ num q < ↑(denom q) := sorry

theorem abs_def (q : ℚ) : abs q = mk ↑(int.nat_abs (num q)) ↑(denom q) := sorry


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

import algebra.big_operators.basic
import algebra.module.basic
import data.nat.interval
import tactic.linarith

/-!
# Results about big operators over intervals

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

We prove results about big operators over intervals (mostly the `ℕ`-valued `Ico m n`).
-/

universes u v w

open_locale big_operators nat

namespace finset

section generic

variables {α : Type u} {β : Type v} {γ : Type w} {s₂ s₁ s : finset α} {a : α}
  {g f : α → β}

variables [comm_monoid β]

@[to_additive]
lemma prod_Ico_add' [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α]
  [locally_finite_order α] (f : α → β) (a b c : α) :
  (∏ x in Ico a b, f (x + c)) = (∏ x in Ico (a + c) (b + c), f x) :=
by { rw [← map_add_right_Ico, prod_map], refl }

@[to_additive]
lemma prod_Ico_add [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α]
  [locally_finite_order α] (f : α → β) (a b c : α) :
  (∏ x in Ico a b, f (c + x)) = (∏ x in Ico (a + c) (b + c), f x) :=
begin
  convert prod_Ico_add' f a b c,
  simp_rw add_comm,
end

lemma sum_Ico_succ_top {δ : Type*} [add_comm_monoid δ] {a b : ℕ}
  (hab : a ≤ b) (f : ℕ → δ) : (∑ k in Ico a (b + 1), f k) = (∑ k in Ico a b, f k) + f b :=
by rw [nat.Ico_succ_right_eq_insert_Ico hab, sum_insert right_not_mem_Ico, add_comm]

@[to_additive]
lemma prod_Ico_succ_top {a b : ℕ} (hab : a ≤ b) (f : ℕ → β) :
  (∏ k in Ico a (b + 1), f k) = (∏ k in Ico a b, f k) * f b :=
@sum_Ico_succ_top (additive β) _ _ _ hab _

lemma sum_eq_sum_Ico_succ_bot {δ : Type*} [add_comm_monoid δ] {a b : ℕ}
  (hab : a < b) (f : ℕ → δ) : (∑ k in Ico a b, f k) = f a + (∑ k in Ico (a + 1) b, f k) :=
have ha : a ∉ Ico (a + 1) b, by simp,
by rw [← sum_insert ha, nat.Ico_insert_succ_left hab]

@[to_additive]
lemma prod_eq_prod_Ico_succ_bot {a b : ℕ} (hab : a < b) (f : ℕ → β) :
  (∏ k in Ico a b, f k) = f a * (∏ k in Ico (a + 1) b, f k) :=
@sum_eq_sum_Ico_succ_bot (additive β) _ _ _ hab _

@[to_additive]
lemma prod_Ico_consecutive (f : ℕ → β) {m n k : ℕ} (hmn : m ≤ n) (hnk : n ≤ k) :
  (∏ i in Ico m n, f i) * (∏ i in Ico n k, f i) = (∏ i in Ico m k, f i) :=
Ico_union_Ico_eq_Ico hmn hnk ▸ eq.symm $ prod_union $ Ico_disjoint_Ico_consecutive m n k

@[to_additive]
lemma prod_Ioc_consecutive (f : ℕ → β) {m n k : ℕ} (hmn : m ≤ n) (hnk : n ≤ k) :
  (∏ i in Ioc m n, f i) * (∏ i in Ioc n k, f i) = (∏ i in Ioc m k, f i) :=
begin
  rw [← Ioc_union_Ioc_eq_Ioc hmn hnk, prod_union],
  apply disjoint_left.2 (λ x hx h'x, _),
  exact lt_irrefl _ ((mem_Ioc.1 h'x).1.trans_le (mem_Ioc.1 hx).2),
end

@[to_additive]
lemma prod_Ioc_succ_top {a b : ℕ} (hab : a ≤ b) (f : ℕ → β) :
  (∏ k in Ioc a (b + 1), f k) = (∏ k in Ioc a b, f k) * f (b + 1) :=
by rw [← prod_Ioc_consecutive _ hab (nat.le_succ b), nat.Ioc_succ_singleton, prod_singleton]

@[to_additive]
lemma prod_range_mul_prod_Ico (f : ℕ → β) {m n : ℕ} (h : m ≤ n) :
  (∏ k in range m, f k) * (∏ k in Ico m n, f k) = (∏ k in range n, f k) :=
nat.Ico_zero_eq_range ▸ nat.Ico_zero_eq_range ▸ prod_Ico_consecutive f m.zero_le h

@[to_additive]
lemma prod_Ico_eq_mul_inv {δ : Type*} [comm_group δ] (f : ℕ → δ) {m n : ℕ} (h : m ≤ n) :
  (∏ k in Ico m n, f k) = (∏ k in range n, f k) * (∏ k in range m, f k)⁻¹ :=
eq_mul_inv_iff_mul_eq.2 $ by rw [mul_comm]; exact prod_range_mul_prod_Ico f h

@[to_additive]
lemma prod_Ico_eq_div {δ : Type*} [comm_group δ] (f : ℕ → δ) {m n : ℕ} (h : m ≤ n) :
  (∏ k in Ico m n, f k) = (∏ k in range n, f k) / (∏ k in range m, f k) :=
by simpa only [div_eq_mul_inv] using prod_Ico_eq_mul_inv f h

@[to_additive]
lemma prod_range_sub_prod_range {α : Type*} [comm_group α] {f : ℕ → α}
  {n m : ℕ} (hnm : n ≤ m) : (∏ k in range m, f k) / (∏ k in range n, f k) =
  ∏ k in (range m).filter (λ k, n ≤ k), f k :=
begin
  rw [← prod_Ico_eq_div f hnm],
  congr,
  apply finset.ext,
  simp only [mem_Ico, mem_filter, mem_range, *],
  tauto,
end

/-- The two ways of summing over `(i,j)` in the range `a<=i<=j<b` are equal. -/
lemma sum_Ico_Ico_comm {M : Type*} [add_comm_monoid M]
  (a b : ℕ) (f : ℕ → ℕ → M) :
  ∑ i in finset.Ico a b, ∑ j in finset.Ico i b, f i j =
  ∑ j in finset.Ico a b, ∑ i in finset.Ico a (j+1), f i j :=
begin
  rw [finset.sum_sigma', finset.sum_sigma'],
  refine finset.sum_bij'
    (λ (x : Σ (i : ℕ), ℕ) _, (⟨x.2, x.1⟩ : Σ (i : ℕ), ℕ)) _ (λ _ _, rfl)
    (λ (x : Σ (i : ℕ), ℕ) _, (⟨x.2, x.1⟩ : Σ (i : ℕ), ℕ)) _
    (by rintro ⟨⟩ _; refl) (by rintro ⟨⟩ _; refl);
  simp only [finset.mem_Ico, sigma.forall, finset.mem_sigma];
  rintros a b ⟨⟨h₁,h₂⟩, ⟨h₃, h₄⟩⟩; refine ⟨⟨_, _⟩, ⟨_, _⟩⟩; linarith
end

@[to_additive]
lemma prod_Ico_eq_prod_range (f : ℕ → β) (m n : ℕ) :
  (∏ k in Ico m n, f k) = (∏ k in range (n - m), f (m + k)) :=
begin
  by_cases h : m ≤ n,
  { rw [←nat.Ico_zero_eq_range, prod_Ico_add, zero_add, tsub_add_cancel_of_le h] },
  { replace h : n ≤ m :=  le_of_not_ge h,
     rw [Ico_eq_empty_of_le h, tsub_eq_zero_iff_le.mpr h, range_zero, prod_empty, prod_empty] }
end

lemma prod_Ico_reflect (f : ℕ → β) (k : ℕ) {m n : ℕ} (h : m ≤ n + 1) :
  ∏ j in Ico k m, f (n - j) = ∏ j in Ico (n + 1 - m) (n + 1 - k), f j :=
begin
  have : ∀ i < m, i ≤ n,
  { intros i hi,
    exact (add_le_add_iff_right 1).1 (le_trans (nat.lt_iff_add_one_le.1 hi) h) },
  cases lt_or_le k m with hkm hkm,
  { rw [← nat.Ico_image_const_sub_eq_Ico (this _ hkm)],
    refine (prod_image _).symm,
    simp only [mem_Ico],
    rintros i ⟨ki, im⟩ j ⟨kj, jm⟩ Hij,
    rw [← tsub_tsub_cancel_of_le (this _ im), Hij, tsub_tsub_cancel_of_le (this _ jm)] },
  { simp [Ico_eq_empty_of_le, tsub_le_tsub_left, hkm] }
end

lemma sum_Ico_reflect {δ : Type*} [add_comm_monoid δ] (f : ℕ → δ) (k : ℕ) {m n : ℕ}
  (h : m ≤ n + 1) :
  ∑ j in Ico k m, f (n - j) = ∑ j in Ico (n + 1 - m) (n + 1 - k), f j :=
@prod_Ico_reflect (multiplicative δ) _ f k m n h

lemma prod_range_reflect (f : ℕ → β) (n : ℕ) :
  ∏ j in range n, f (n - 1 - j) = ∏ j in range n, f j :=
begin
  cases n,
  { simp },
  { simp only [←nat.Ico_zero_eq_range, nat.succ_sub_succ_eq_sub, tsub_zero],
    rw prod_Ico_reflect _ _ le_rfl,
    simp }
end

lemma sum_range_reflect {δ : Type*} [add_comm_monoid δ] (f : ℕ → δ) (n : ℕ) :
  ∑ j in range n, f (n - 1 - j) = ∑ j in range n, f j :=
@prod_range_reflect (multiplicative δ) _ f n

@[simp] lemma prod_Ico_id_eq_factorial : ∀ n : ℕ, ∏ x in Ico 1 (n + 1), x = n!
| 0 := rfl
| (n+1) := by rw [prod_Ico_succ_top $ nat.succ_le_succ $ zero_le n,
  nat.factorial_succ, prod_Ico_id_eq_factorial n, nat.succ_eq_add_one, mul_comm]

@[simp] lemma prod_range_add_one_eq_factorial : ∀ n : ℕ, ∏ x in range n, (x+1) = n!
| 0 := rfl
| (n+1) := by simp [finset.range_succ, prod_range_add_one_eq_factorial n]

section gauss_sum

/-- Gauss' summation formula -/
lemma sum_range_id_mul_two (n : ℕ) :
  (∑ i in range n, i) * 2 = n * (n - 1) :=
calc (∑ i in range n, i) * 2 = (∑ i in range n, i) + (∑ i in range n, (n - 1 - i)) :
  by rw [sum_range_reflect (λ i, i) n, mul_two]
... = ∑ i in range n, (i + (n - 1 - i)) : sum_add_distrib.symm
... = ∑ i in range n, (n - 1) : sum_congr rfl $ λ i hi, add_tsub_cancel_of_le $
  nat.le_pred_of_lt $ mem_range.1 hi
... = n * (n - 1) : by rw [sum_const, card_range, nat.nsmul_eq_mul]

/-- Gauss' summation formula -/
lemma sum_range_id (n : ℕ) : (∑ i in range n, i) = (n * (n - 1)) / 2 :=
by rw [← sum_range_id_mul_two n, nat.mul_div_cancel]; exact dec_trivial

end gauss_sum

end generic

section nat

variable {β : Type*}
variables (f g : ℕ → β) {m n : ℕ}

section group

variable [comm_group β]

@[to_additive]
lemma prod_range_succ_div_prod : (∏ i in range (n+1), f i) / ∏ i in range n, f i = f n :=
div_eq_iff_eq_mul'.mpr $ prod_range_succ f n

@[to_additive]
lemma prod_range_succ_div_top : (∏ i in range (n+1), f i) / f n = ∏ i in range n, f i :=
div_eq_iff_eq_mul.mpr $ prod_range_succ f n

@[to_additive]
lemma prod_Ico_div_bot (hmn : m < n) : (∏ i in Ico m n, f i) / f m = ∏ i in Ico (m+1) n, f i :=
div_eq_iff_eq_mul'.mpr $ prod_eq_prod_Ico_succ_bot hmn _

@[to_additive]
lemma prod_Ico_succ_div_top (hmn : m ≤ n) : (∏ i in Ico m (n+1), f i) / f n = ∏ i in Ico m n, f i :=
div_eq_iff_eq_mul.mpr $ prod_Ico_succ_top hmn _

end group

end nat

section module

variables {R M : Type*} [ring R] [add_comm_group M] [module R M] (f : ℕ → R) (g : ℕ → M) {m n : ℕ}
open finset
-- The partial sum of `g`, starting from zero
local notation `G ` n:80 := ∑ i in range n, g i

/-- **Summation by parts**, also known as **Abel's lemma** or an **Abel transformation** -/
theorem sum_Ico_by_parts (hmn : m < n) :
  ∑ i in Ico m n, f i • g i =
  f (n-1) • G n - f m • G m - ∑ i in Ico m (n-1), (f (i+1) - f i) • G (i+1) :=
begin
  have h₁ : ∑ i in Ico (m+1) n, (f i • G i) = ∑ i in Ico m (n-1), (f (i+1) • G (i+1)),
  { conv in n { rw ←nat.sub_add_cancel (nat.one_le_of_lt hmn) },
    rw ←sum_Ico_add' },
  have h₂ : ∑ i in Ico (m+1) n, (f i • G (i+1))
          = ∑ i in Ico m (n-1), (f i • G (i+1)) + f (n-1) • G n - f m • G (m+1) :=
  by rw [←sum_Ico_sub_bot _ hmn, ←sum_Ico_succ_sub_top _ (nat.le_pred_of_lt hmn),
         nat.sub_add_cancel (pos_of_gt hmn), sub_add_cancel],
  rw sum_eq_sum_Ico_succ_bot hmn,
  conv { for (f _ • g _) [2] { rw ← sum_range_succ_sub_sum g } },
  simp_rw [smul_sub, sum_sub_distrib, h₂, h₁],
  conv_lhs { congr, skip, rw [←add_sub, add_comm, ←add_sub, ←sum_sub_distrib] },
  have : ∀ i, f i • G (i+1) - f (i+1) • G (i+1) = -((f (i+1) - f i) • G (i+1)),
  { intro i,
    rw sub_smul,
    abel },
  simp_rw [this, sum_neg_distrib, sum_range_succ, smul_add],
  abel,
end

variable (n)

/-- **Summation by parts** for ranges -/
lemma sum_range_by_parts :
  ∑ i in range n, (f i • g i) = f (n-1) • G n - ∑ i in range (n-1), (f (i+1) - f i) • G (i+1) :=
begin
  by_cases hn : n = 0,
  { simp [hn], },
  { rw [range_eq_Ico, sum_Ico_by_parts f g (nat.pos_of_ne_zero hn), sum_range_zero,
      smul_zero, sub_zero, range_eq_Ico] },
end

end module

end finset


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_15
  (s : ℕ+ → ℕ+ → ℕ+)
  (h₀ : ∀ a b, s a b = a^(b:ℕ) + b^(a:ℕ)) :
  s 2 6 = 100 :=
begin
  rw h₀,
  refl,
end


import convex convex_body multiset brunn_minkowski
  finset polytope touching_cone
  linear_algebra.affine_space.affine_subspace
  topology.continuous_function.bounded
  measure_theory.measure.measure_space
  analysis.convex.basic
  data.multiset.basic
  topology.basic

open_locale pointwise

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

open_locale pointwise

section types

variables (V : Type)
[inner_product_space ℝ V] [finite_dimensional ℝ V]

abbreviation unbounded_microid_generator (k : ℕ) := fin k.succ → V
abbreviation microid_generator_space (k : ℕ) := metric.closed_ball (0 : fin k.succ → V) 1

noncomputable instance borel_measurable_space_microid_generator_space (k : ℕ) :=
borel
(microid_generator_space V k)

instance borel_space_microid_generator_space (k : ℕ) :
borel_space (microid_generator_space V k) :=
⟨rfl⟩

instance proper_space_microid_generator_space (k : ℕ) :
compact_space (microid_generator_space V k) :=
{
  compact_univ :=
  begin
    apply compact_iff_compact_in_subtype.mpr,
    simp only [set.image_univ, subtype.range_coe_subtype],
    exact proper_space.is_compact_closed_ball 0 1,
  end
}

def function_of_generator {k : ℕ}
(G : microid_generator_space V k) : fin k.succ → V := G.val

abbreviation microid_measure (k : ℕ) :=
measure_theory.finite_measure (microid_generator_space V k)

end types

axiom microid_of_measure {V : Type}
[inner_product_space ℝ V] [finite_dimensional ℝ V]
{k : ℕ} (μ : microid_measure V k) :
convex_body V

section bla

variables {V : Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

lemma finite_generator_range {k : ℕ} (G : microid_generator_space V k) :
(set.range G.val).finite :=
begin
  rw [set_range_eq_finset_range G.val],
  apply finset.finite_to_set,
end

def polytope_of_microid_generator {k : ℕ} (G : microid_generator_space V k) :
polytope V :=
begin
  refine ⟨convex_hull ℝ (set.range G.val), _⟩,
  simp only [is_polytope],
  refine ⟨set.range G.val, _, _, rfl⟩,
  {
    simp only [←set.image_univ],
    refine set.finite.of_finset (finset.image G.val finset.univ) _,
    simp only [←finset.mem_coe, finset.coe_image, finset.coe_univ],
    tauto,
  },
  {
    exact ⟨G.val 0, set.mem_range_self 0⟩,
  },
end

def body_of_microid_generator {k : ℕ} (G : microid_generator_space V k) :
convex_body V :=
begin
  refine ⟨convex_hull ℝ (set.range G.val), _, _, _⟩,
  {
    apply convex_convex_hull,
  },
  {
    refine metric.compact_iff_closed_bounded.mpr ⟨_, _⟩,
    {
      apply set.finite.is_closed_convex_hull,
      apply finite_generator_range,
    },
    {
      apply bounded_convex_hull.mpr,
      refine (metric.bounded_iff_is_bounded _).mpr (set.finite.is_bounded _),
      apply finite_generator_range,
    },
  },
  {
    refine ⟨G.val 0, _⟩,
    refine (subset_convex_hull ℝ _) _,
    refine ⟨0, rfl⟩,
  },
end

lemma body_of_poly_of_gen_eq {k : ℕ}
{G : microid_generator_space V k} :
convex_body_of_polytope (polytope_of_microid_generator G) =
body_of_microid_generator G :=
begin
  simp only [convex_body_of_polytope, polytope_of_microid_generator,
  body_of_microid_generator],
  refl,
end

noncomputable def support_eval {k : ℕ} (u : V) :
microid_generator_space V k → ℝ :=
λ G, (body_of_microid_generator G).supp u

lemma supp_microid_eq_integral {k : ℕ} (μ : microid_measure V k) :
(microid_of_measure μ).supp = (λ u, ∫ G, (body_of_microid_generator G).supp u ∂μ.val) := sorry

/- lemma supp_microid_eq_integral' {k : ℕ} (μ : microid_measure V k) :
(microid_of_measure μ).supp = (λ u, ∫ G in msupport μ, (body_of_microid_generator G).supp u ∂μ.val) := sorry -/

lemma msupport_microid_eq_closure {k : ℕ}
(μ : microid_measure V k)
{C : multiset (convex_body V)}
(hC : dim V = C.card + 2) :
msupport (bm.area (microid_of_measure μ ::ₘ C)) =
closure (⋃ L ∈ msupport μ, msupport (bm.area (body_of_microid_generator L ::ₘ C))) := sorry

-- only used for c > 0
def cuspy_cone (x : V) (u : V) (c : ℝ) :=
{ y : V | ⟪x - y, u⟫_ℝ ≥ c * ∥ y - x ∥ }

def is_cuspy (A : set V) (u : V) (c : ℝ) :=
∃ x ∈ A, A ⊆ cuspy_cone x u c

/- lemma cuspy_iff_TS_zero (K : convex_body V) (u : V) :
TS K.val = 0 ↔ ∃ c > 0, is_cuspy K.val u c := sorry

lemma cuspy_generators_of_cuspy {k : ℕ} {μ : microid_measure V k.succ} {u : V} {c > 0}
(h : is_cuspy (microid_of_measure μ).val u c) :
∀ G ∈ msupport μ, is_cuspy (polytope_of_microid_generator G).val u c := sorry -/

def is_default_polytope {k : ℕ} (μ : microid_measure V k) (u : metric.sphere (0 : V) 1)
(P : microid_generator_space V k) :=
0 ∈ (polytope_of_microid_generator P).val ∧
vector_span ℝ (polytope_of_microid_generator P).val ≤ vector_orth u.val ∧
TS (polytope_of_microid_generator P).val u ≠ 0 ∧
(∀ C : multiset (convex_body V),
dim V = C.card + 2 →
u ∈ msupport (bm.area ((convex_body_of_polytope (polytope_of_microid_generator P)) ::ₘ C)) →
u ∈ msupport (bm.area (microid_of_measure μ ::ₘ C)))

/- lemma finset_sum_pi_eq {α β: Type} {s : finset α}
(f : α → β → V) :
s.sum f = λ b : β, s.sum (λ a : α, f a b) :=
begin
  funext,
  exact finset.sum_apply _ _ _,
end -/

lemma finset_sum_fn_add {α : Type} {s : finset α} (f : α → V) (g : α → V):
s.sum f + s.sum g = s.sum (f + g) :=
begin
  simp only [finset.sum, multiset.sum_map_add.symm],
  refl,
end

lemma finset_sum_fn_sub {α : Type} {s : finset α} (f : α → V) (g : α → V):
s.sum f - s.sum g = s.sum (f - g) :=
begin
  simp only [finset.sum, multiset.sum_map_sub.symm],
  refl,
end

/- lemma real_convex_combination_le {α : Type} {s : finset α}
{w : α → ℝ} {f : α → ℝ} {g : α → ℝ}
(hw₀ : ∀ x : α, x ∈ s → w x ≥ 0)
(hle : f ≤ g) :
s.sum (λ x, w x * f x) ≤ s.sum (λ x, w x * g x) :=
begin
  admit,
end -/

lemma dist_convex_combination_le {k : ℕ}
(G H : microid_generator_space V k)
{s : finset (fin k.succ)}
{w : fin k.succ → ℝ}
(hw₀ : ∀ x : fin k.succ, x ∈ s → w x ≥ 0)
(hw₁ : s.sum w = 1)
: dist (s.affine_combination G.val w) (s.affine_combination H.val w) ≤
dist G H :=
begin
  simp only [dist_eq_norm, finset.affine_combination, finset.weighted_vsub_of_point_apply, vsub_eq_sub, vadd_eq_add,
  affine_map.coe_mk, add_sub_add_right_eq_sub],
  simp only [finset_sum_fn_sub _ _, pi.sub_def, (smul_sub _ _ _).symm],
  refine le_trans (norm_sum_le _ _) _,
  simp only [norm_smul, real.norm_eq_abs],
  simp only [sub_sub_sub_cancel_right],
  simp only [(pi.sub_apply G.val H.val _).symm],
  have : ∀ x : fin k.succ, x ∈ s → |w x| * ∥(G.val - H.val) x∥ ≤ w x * ∥G.val - H.val∥,
  {
    intros x hx,
    simp only [abs_of_nonneg (hw₀ x hx)],
    refine mul_le_mul_of_nonneg_left _ _,
    {exact norm_le_pi_norm (G.val - H.val) x},
    {exact hw₀ x hx},
  },
  refine le_trans (finset.sum_le_sum this) _,
  rw [←finset.sum_mul],
  simp only [hw₁, one_mul],
  change ∥G.val - H.val∥ ≤ dist G.val H.val,
  simp only [dist_eq_norm],
end

lemma body_of_gen_lipschitz {k : ℕ} :
lipschitz_with 1 (body_of_microid_generator : microid_generator_space V k → convex_body V) :=
begin
  rintro x y,
  simp only [ennreal.coe_one, one_mul],
  simp only [edist_dist, body_of_microid_generator, dist_body_eq_Hausdorff_edist],
  -- apply ennreal.of_real_le_of_real,
  have : dist x y = dist x.val y.val := rfl,
  apply emetric.Hausdorff_edist_le_of_mem_edist,
  {
    intros v hv,
    simp only [convex_hull_range_eq_exists_affine_combination _,
      set.mem_set_of] at hv ⊢,
    rcases hv with ⟨s, w, hw₀, hw₁, rfl⟩,
    refine ⟨s.affine_combination y.val w, _, _⟩,
    {
      exact ⟨s, w, hw₀, hw₁, rfl⟩,
    },
    {
      rw [edist_dist],
      apply ennreal.of_real_le_of_real,
      refine dist_convex_combination_le _ _ hw₀ hw₁,
    },
  },
  {
    intros v hv,
    simp only [convex_hull_range_eq_exists_affine_combination _,
      set.mem_set_of] at hv ⊢,
    rcases hv with ⟨s, w, hw₀, hw₁, rfl⟩,
    refine ⟨s.affine_combination x.val w, _, _⟩,
    {
      exact ⟨s, w, hw₀, hw₁, rfl⟩,
    },
    {
      rw [edist_dist],
      apply ennreal.of_real_le_of_real,
      rw [dist_comm],
      refine dist_convex_combination_le _ _ hw₀ hw₁,
    },
  },
end

lemma body_of_gen_continuous_at {k : ℕ} (G : microid_generator_space V k) :
continuous_at (body_of_microid_generator : microid_generator_space V k → convex_body V) G :=
begin
  apply continuous_at_of_locally_lipschitz zero_lt_one 1,
  rintro H -,
  have := body_of_gen_lipschitz H G,
  simpa only [edist_dist, ennreal.coe_one, one_mul,
    ennreal.of_real_le_of_real_iff dist_nonneg] using this,
end

-- uses pruning lemma
/- lemma exists_default_polytope_of_TS_nonzero {k : ℕ} {μ : microid_measure V k}
(h : TS (microid_of_measure μ).val ≠ 0) (u : metric.sphere (0 : V) 1) :
∃ P : microid_generator_space V k, is_default_polytope μ u P := sorry
 -/

noncomputable def project_generator {k : ℕ} (E : submodule ℝ V)
(G : microid_generator_space V k) :
microid_generator_space E k :=
begin
  refine ⟨(proj E) ∘ G.val, _⟩,
  simp only [subtype.val_eq_coe, mem_closed_ball_zero_iff],
  simp only [pi_norm_le_iff zero_le_one, function.comp_app],
  intro l,
  simp only [proj],
  simp only [continuous_linear_map.to_linear_map_eq_coe,
    continuous_linear_map.coe_coe, submodule.coe_norm],
  refine le_trans (continuous_linear_map.le_op_norm (orthogonal_projection E) _) _,
  refine le_trans (mul_le_mul (orthogonal_projection_norm_le E) (norm_le_pi_norm _ _) (norm_nonneg _) zero_le_one) _,
  simpa only [one_mul, mem_closed_ball_iff_norm, sub_zero] using G.property,
end

lemma microid_eval_continuous {k : ℕ} {i : fin k.succ} :
continuous (λ G : microid_generator_space V k, G.val i) :=
begin
  apply lipschitz_with.continuous, rotate, exact 1,
  intros G H,
  simp only [subtype.val_eq_coe, edist_eq_coe_nnnorm_sub],
  rw [subtype.edist_eq, edist_eq_coe_nnnorm_sub],
  simp only [ennreal.coe_one, one_mul, ennreal.coe_le_coe,
    ←pi.sub_apply],
  apply nnnorm_le_pi_nnnorm,
end

lemma project_generator_continuous {k : ℕ} {E : submodule ℝ V} :
continuous
(project_generator E : microid_generator_space V k →
microid_generator_space E k) :=
begin
  have : project_generator E = λ G, project_generator E G := rfl,
  rw [this],
  simp only [project_generator],
  refine continuous_subtype_mk _ _,
  refine continuous_pi (λ i, (map_continuous _).comp _),
  exact microid_eval_continuous,
end

lemma project_generator_measurable {k : ℕ} {E : submodule ℝ V} :
measurable
(project_generator E : microid_generator_space V k →
microid_generator_space E k) :=
begin
  exact project_generator_continuous.measurable,
end

-- MOVETO ???
lemma subset_cthickening_of_Hausdorff_edist_le
{A B : set V} {r : ℝ}
(h : emetric.Hausdorff_edist A B ≤ ennreal.of_real r) :
A ⊆ metric.cthickening r B :=
begin
  intros a ha,
  simp only [metric.mem_cthickening_iff],
  refine le_trans _ h,
  apply emetric.inf_edist_le_Hausdorff_edist_of_mem,
  exact ha,
end

lemma subset_cthickening_Hausdorff_dist
{A B : set V}
(h : emetric.Hausdorff_edist A B ≠ ⊤) :
A ⊆ metric.cthickening (metric.Hausdorff_dist A B) B :=
begin
  apply subset_cthickening_of_Hausdorff_edist_le,
  simp only [metric.Hausdorff_dist,
    ennreal.of_real_to_real h],
  exact le_refl _,
end

lemma body_supp_eval_continuous {u : V} :
continuous (λ K : convex_body V, K.supp u) :=
begin
  apply lipschitz_with.continuous, rotate, exact ∥u∥₊,
  intros K L,
  simp only [edist_body_eq_Hausdorff_edist, ennreal.coe_one, one_mul],
  simp only [edist_dist, dist_eq_norm, real.norm_eq_abs],
  rw [Hausdorff_edist_dist edist_body_ne_top],
  rw [←nnnorm_norm, real.ennnorm_eq_of_real (norm_nonneg _),
    ←ennreal.of_real_mul (norm_nonneg _)],
  apply ennreal.of_real_le_of_real,
  rcases K.supp_exists_mem_face u
    with ⟨k, kf, hk⟩,
  rcases L.supp_exists_mem_face u
    with ⟨l, lf, hl⟩,
  rw [←hk, ←hl],
  rw [abs_sub_le_iff], split,
  {
    have : metric.inf_dist k L.val ≤ metric.Hausdorff_dist K.val L.val,
    {
      apply metric.inf_dist_le_Hausdorff_dist_of_mem,
      {
        exact normal_face_subset kf,
      },
      {
        exact edist_body_ne_top,
      },
    },
    refine le_trans _ (mul_le_mul_of_nonneg_left this (norm_nonneg _)),
    rcases is_closed.exists_inf_dist_eq_dist
      L.is_closed
      L.nonempty
      k
      with ⟨l', l'L, hl'⟩,
    rw [hl'],
    rw [mem_normal_face] at lf,
    refine le_trans (sub_le_sub_left (lf.2 _ l'L) _) _,
    rw [←inner_sub_left],
    refine le_trans (real_inner_le_norm _ _) _,
    nth_rewrite 0 [mul_comm],
    rw [dist_eq_norm],
  },
  { -- it might have been nicer to use the wlog tactic
    have : metric.inf_dist l K.val ≤ metric.Hausdorff_dist K.val L.val,
    {
      rw [metric.Hausdorff_dist_comm],
      apply metric.inf_dist_le_Hausdorff_dist_of_mem,
      {
        exact normal_face_subset lf,
      },
      {
        exact edist_body_ne_top,
      },
    },
    refine le_trans _ (mul_le_mul_of_nonneg_left this (norm_nonneg _)),
    rcases is_closed.exists_inf_dist_eq_dist
      K.is_closed
      K.nonempty
      l
      with ⟨k', k'K, hk'⟩,
    rw [hk'],
    rw [mem_normal_face] at kf,
    refine le_trans (sub_le_sub_left (kf.2 _ k'K) _) _,
    rw [←inner_sub_left],
    refine le_trans (real_inner_le_norm _ _) _,
    nth_rewrite 0 [mul_comm],
    rw [dist_eq_norm],
  },
  apply_instance,
end

lemma supp_eval_continuous {k : ℕ} {u : V} :
continuous (support_eval u : microid_generator_space V k → ℝ) :=
begin
  convert continuous.comp
    body_supp_eval_continuous
    body_of_gen_lipschitz.continuous,
end

lemma supp_eval_strongly_measurable {k : ℕ} {u : V} :
measure_theory.strongly_measurable (support_eval u : microid_generator_space V k → ℝ) :=
begin
  exact supp_eval_continuous.strongly_measurable,
end

noncomputable def project_microid_measure {k : ℕ} (E : submodule ℝ V) (μ : microid_measure V k) :
microid_measure E k := finite_measure_map (project_generator E) μ

lemma microid_generator.proj_body {k : ℕ} (E : submodule ℝ V)
(G : microid_generator_space V k) :
proj_body E (body_of_microid_generator G) =
body_of_microid_generator (project_generator E G) :=
begin
  simp only [proj_body, project_generator, body_of_microid_generator],
  simp only [←(proj E).coe_to_affine_map, affine_map.image_convex_hull,
    set.range_comp],
end

lemma proj_microid_of_measure {k : ℕ}
(E : submodule ℝ V)
(μ : microid_measure V k) :
proj_body E (microid_of_measure μ) = microid_of_measure (project_microid_measure E μ) :=
begin
  apply convex_body.supp_injective,
  funext,
  simp only [convex_body.proj_supp, supp_microid_eq_integral],
  simp only [project_microid_measure, finite_measure_map, measure_theory.finite_measure.val_eq_to_measure],
  rw [measure_theory.integral_map],
  {
    simp only [←microid_generator.proj_body, convex_body.proj_supp],
  },
  {
    exact project_generator_measurable.ae_measurable,
  },
  {
    exact supp_eval_strongly_measurable.ae_strongly_measurable,
  },
end

lemma microid_proj_eq_proj_microid {k : ℕ}
(μ : microid_measure V k)
(E : submodule ℝ V) :
microid_of_measure (project_microid_measure E μ) = proj_body E (microid_of_measure μ) :=
begin
  symmetry,
  apply proj_microid_of_measure,
end

noncomputable def dirac_microid_measure {k : ℕ}
(P : microid_generator_space V k) : microid_measure V k :=
begin
  refine ⟨measure_theory.measure.dirac P, ⟨_⟩⟩, -- trivial
  simp only [measure_theory.is_probability_measure.measure_univ, ennreal.one_lt_top],
end

lemma microid_of_dirac_eq {k : ℕ}
(P : microid_generator_space V k) :
microid_of_measure (dirac_microid_measure P) = body_of_microid_generator P :=
begin
  apply convex_body.supp_injective,
  funext,
  simp only [supp_microid_eq_integral, dirac_microid_measure],
  simp only [measure_theory.integral_dirac],
end

end bla


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units {p : ℕ} (hp : prime p) (x : ℕ) : coprime x p → is_unit (x : ℤ_[p]) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  assume h1 : ¬ is_unit (x : ℤ_[p]),
  -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
  have h2 : ¬ (∥x∥ = 1), from by {rw ← norm_eq_one_iff_unit, exact h1},
  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
  have h3 : ∥x∥ < 1, from by {rw ← norm_eq_one_iff_unit, exact h1},
  -- But this must imply that $p | x$.
  have h4 : p ∣ x, from by {apply norm_lt_one_iff_dvd_prime hp h3},
  -- This completes our proof.
  exact h4,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (x : ℤ_[p]) :=
begin
  assume h1 : coprime p x,
  have h2 : ¬ is_unit (x : ℤ_[p]), from by {
    assume h3 : is_unit (x : ℤ_[p]),
    have h4 : (x : ℤ_[p]) ≠ 0, from by {
      assume h5 : (x : ℤ_[p]) = 0,
      have h6 : x = 0, from by {
        rw ← h5,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h6,
        apply nat.zero_dvd,
      },
    },
    have h7 : (x : ℤ_[p]) ≠ 1, from by {
      assume h8 : (x : ℤ_[p]) = 1,
      have h9 : x = 1, from by {
        rw ← h8,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h9,
        apply nat.one_dvd,
      },
    },
    have h10 : (x : ℤ_[p]) ≠ -1, from by {
      assume h11 : (x : ℤ_[p]) = -1,
      have h12 : x = -1, from by {
        rw ← h11,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h12,
        apply nat.neg_one_dvd,
      },
    },
    have h13 : (x : ℤ_[p]) ≠ p, from by {
      assume h14 : (x : ℤ_[p]) = p,
      have h15 : x = p, from by {
        rw ← h14,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h15,
        apply nat.prime.dvd_prime,
        exact h1.left,
      },
    },
    have h16 : (x : ℤ_[p]) ≠ -p, from by {
      assume h17 : (x : ℤ_[p]) = -p,
      have h18 : x = -p, from by {
        rw ← h17,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h18,
        apply nat.prime.dvd_neg_prime,
        exact h1.left,
      },
    },
    have h19 : (x : ℤ_[p]) ≠ p^2, from by {
      assume h20 : (x : ℤ_[p]) = p^2,
      have h21 : x = p^2, from by {
        rw ← h20,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h21,
        apply nat.prime.dvd_pow,
        exact h1.left,
      },
    },
    have h22 : (x : ℤ_[p]) ≠ -p^2, from by {
      assume h23 : (x : ℤ_[p]) = -p^2,
      have h24 : x = -p^2, from by {
        rw ← h23,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h24,
        apply nat.prime.dvd_neg_pow,
        exact h1.left,
      },
    },
    have h25 : (x : ℤ_[p]) ≠ p^3, from by {
      assume h26 : (x : ℤ_[p]) = p^3,
      have h27 : x = p^3, from by {
        rw ← h26,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h27,
        apply nat.prime.dvd_pow,
        exact h1.left,
      },
    },
    have h28 : (x : ℤ_[p]) ≠ -p^3, from by {
      assume h29 : (x : ℤ_[p]) = -p^3,
      have h30 : x = -p^3, from by {
        rw ← h29,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h30,
        apply nat.prime.dvd_neg_pow,
        exact h1.left,
      },
    },
    have h31 : (x : ℤ_[p]) ≠ p^4, from by {
      assume h32 : (x : ℤ_[p]) = p^4,
      have h33 : x = p^4, from by {
        rw ← h32,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h33,
        apply nat.prime.dvd_pow,
        exact h1.left,
      },
    },
    have h34 : (x : ℤ_[p]) ≠ -p^4, from by {
      assume h35 : (x : ℤ_[p]) = -p^4,
      have h36 : x = -p^4, from by {
        rw ← h35,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h36,
        apply nat.prime.dvd_neg_pow,
        exact h1.left,
      },
    },
    have h37 : (x : ℤ_[p]) ≠ p^5, from by {
      assume h38 : (x : ℤ_[p]) = p^5,
      have h39 : x = p^5, from by {
        rw ← h38,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h39,
        apply nat.prime.dvd_pow,
        exact h1.left,
      },
    },
    have h40 : (x : ℤ_[p]) ≠ -p^5, from by {
      assume h41 : (x : ℤ_[p]) = -p^5,
      have h42 : x = -p^5, from by {
        rw ← h41,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h42,
        apply nat.prime.dvd_neg_pow,
        exact h1.left,
      },
    },
    have h43 : (x : ℤ_[p]) ≠ p^6, from by {
      assume h44 : (x : ℤ_[p]) = p^6,
      have h45 : x = p^6, from by {
        rw ← h44,
        apply int.cast_inj,
      },
      show false, from by {
        apply h1.right,
        rw h45,
        apply nat.prime.dvd_pow,
        exact h1.left,
      },
    },
    have h46 : (x : ℤ_[p]) ≠ -p^6, from by {
      assume h47 : (x : ℤ_[p]) = -p^6,
      have h48 : x = -p^6, from by {
        rw ← h47,
        apply
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (x : ℤ_[p]) :=
begin
  assume h1 : coprime p x,
  have h2 : x ≠ 0, from by {
    assume h3 : x = 0,
    have h4 : p ∣ 0, from by {
      apply dvd_of_dvd_mul_left h3,
    },
    have h5 : p = 0, from by {
      apply eq_zero_of_dvd_zero h4,
    },
    have h6 : p ≠ 0, from by {
      apply nat.prime.ne_zero p,
    },
    show false, from by {
      apply h6 h5,
    },
  },
  have h3 : (x : ℤ_[p]) ≠ 0, from by {
    apply int.coe_nat_ne_zero.mpr h2,
  },
  have h4 : (x : ℤ_[p]) = 1 ∨ (x : ℤ_[p]) = -1, from by {
    apply int.units_of_dvd_one h3,
  },
  have h5 : (x : ℤ_[p]) = 1, from by {
    apply or.resolve_left h4,
    assume h6 : (x : ℤ_[p]) = -1,
    have h7 : (x : ℤ_[p]) = 1, from by {
      apply int.neg_eq_neg_one_of_eq_one h6,
    },
    show false, from by {
      apply h7.symm h6,
    },
  },
  have h6 : (x : ℤ_[p]) = 1, from by {
    apply or.resolve_right h4,
    assume h7 : (x : ℤ_[p]) = 1,
    exact h7,
  },
  show is_unit (x : ℤ_[p]), from by {
    apply int.is_unit_of_one_mul h6,
  },
end

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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


import data.multiset
import data.finset
import data.list.basic
import .module_filtration
import .quiver
import .lattices

variables {R : Type} [ring R] {M : Module R}

variable (F : filtration (submodule R M))

structure generalised_alperin_diagram :=
  (diagram : quiver)
  (ac : is_acyclic diagram)
  (s : diagram.vertices → { a // a ∈ F.factors })
  (bs : function.bijective s)
  (delta : downset diagram.vertices → submodule R M)
  (id : function.injective delta)
  (lat_hom : is_lattice_hom delta)

instance : has_coe (generalised_alperin_diagram F) quiver := ⟨ λ D, generalised_alperin_diagram.diagram D⟩

variable (D : generalised_alperin_diagram F)

instance gad_is_acyclic (D : generalised_alperin_diagram F) : is_acyclic D := D.ac
instance gad_is_pordered : partial_order (D : quiver).vertices := quiver_vertices_partial _

theorem t_1_2 :
    ∀ (A B : downset (D : quiver).vertices), A ≤ B ↔ D.delta A ≤ D.delta B :=
    begin
      intros;
      split;
        intros;
        have h₁ : preserves_meet D.delta := D.lat_hom.preserves_meet,
        exact homo_preserves_lt_1 D.delta h₁ A B a,
        have h₂ : function.injective D.delta := D.id;
        exact homo_preserves_lt_2 _ h₂ h₁ _ _ a
    end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Probability mass function -- discrete probability measures
-/
import analysis.nnreal analysis.ennreal analysis.topology.infinite_sum
noncomputable theory
variables {α : Type*} {β : Type*} {γ : Type*}
local attribute [instance] classical.prop_decidable

/-- Probability mass functions, i.e. discrete probability measures -/
def {u} pmf (α : Type u) : Type u := { f : α → nnreal // is_sum f 1 }

namespace pmf

instance : has_coe_to_fun (pmf α) := ⟨λp, α → nnreal, λp a, p.1 a⟩

@[extensionality] protected lemma ext : ∀{p q : pmf α}, (∀a, p a = q a) → p = q
| ⟨f, hf⟩ ⟨g, hg⟩ eq :=  subtype.eq $ funext eq

lemma is_sum_coe_one (p : pmf α) : is_sum p 1 := p.2

lemma has_sum_coe (p : pmf α) : has_sum p := has_sum_spec p.is_sum_coe_one

@[simp] lemma tsum_coe (p : pmf α) : (∑a, p a) = 1 := tsum_eq_is_sum p.is_sum_coe_one

def support (p : pmf α) : set α := {a | p.1 a ≠ 0}

def pure (a : α) : pmf α := ⟨λa', if a' = a then 1 else 0, is_sum_ite _ _⟩

@[simp] lemma pure_apply (a a' : α) : pure a a' = (if a' = a then 1 else 0) := rfl

instance [inhabited α] : inhabited (pmf α) := ⟨pure (default α)⟩

lemma coe_le_one (p : pmf α) (a : α) : p a ≤ 1 :=
is_sum_le (by intro b; split_ifs; simp [h]; exact le_refl _) (is_sum_ite a (p a)) p.2

protected lemma bind.has_sum (p : pmf α) (f : α → pmf β) (b : β) : has_sum (λa:α, p a * f a b) :=
begin
  refine nnreal.has_sum_of_le (assume a, _) p.has_sum_coe,
  suffices : p a * f a b ≤ p a * 1, { simpa },
  exact mul_le_mul_of_nonneg_left ((f a).coe_le_one _) (p a).2
end

def bind (p : pmf α) (f : α → pmf β) : pmf β :=
⟨λb, (∑a, p a * f a b),
  begin
    simp [ennreal.is_sum_coe.symm, (ennreal.tsum_coe (bind.has_sum p f _)).symm],
    rw [is_sum_iff_of_has_sum ennreal.has_sum, ennreal.tsum_comm],
    simp [ennreal.mul_tsum, (ennreal.tsum_coe (f _).has_sum_coe),
      ennreal.tsum_coe p.has_sum_coe]
  end⟩

@[simp] lemma bind_apply (p : pmf α) (f : α → pmf β) (b : β) : p.bind f b = (∑a, p a * f a b) := rfl

lemma coe_bind_apply (p : pmf α) (f : α → pmf β) (b : β) :
  (p.bind f b : ennreal) = (∑a, p a * f a b) :=
eq.trans (ennreal.tsum_coe $ bind.has_sum p f b).symm $ by simp

@[simp] lemma pure_bind (a : α) (f : α → pmf β) : (pure a).bind f = f a :=
have ∀b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
  assume b a', by split_ifs; simp; subst h; simp,
by ext b; simp [this]

@[simp] lemma bind_pure (p : pmf α) : p.bind pure = p :=
have ∀a a', (p a * ite (a' = a) 1 0) = ite (a = a') (p a') 0, from
  assume a a', begin split_ifs; try { subst a }; try { subst a' }; simp * at * end,
by ext b; simp [this]

@[simp] lemma bind_bind (p : pmf α) (f : α → pmf β) (g : β → pmf γ) :
  (p.bind f).bind g = p.bind (λa, (f a).bind g) :=
begin
  ext b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.mul_tsum.symm, ennreal.tsum_mul.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
  p.bind (λa, q.bind (f a)) = q.bind (λb, p.bind (λa, f a b)) :=
begin
  ext b,
  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.mul_tsum.symm, ennreal.tsum_mul.symm],
  rw [ennreal.tsum_comm],
  simp [mul_assoc, mul_left_comm, mul_comm]
end

def map (f : α → β) (p : pmf α) : pmf β := bind p (pure ∘ f)

lemma bind_pure_comp (f : α → β) (p : pmf α) : bind p (pure ∘ f) = map f p := rfl

lemma map_id (p : pmf α) : map id p = p := by simp [map]

lemma map_comp (p : pmf α) (f : α → β) (g : β → γ) : (p.map f).map g = p.map (g ∘ f) :=
by simp [map]

lemma pure_map (a : α) (f : α → β) : (pure a).map f = pure (f a) :=
by simp [map]

def seq (f : pmf (α → β)) (p : pmf α) : pmf β := f.bind (λm, p.bind $ λa, pure (m a))

def of_multiset (s : multiset α) (hs : s ≠ 0) : pmf α :=
⟨λa, s.count a / s.card,
  have s.to_finset.sum (λa, (s.count a : ℝ) / s.card) = 1,
    by simp [div_eq_inv_mul, finset.mul_sum.symm, (finset.sum_nat_cast _ _).symm, hs],
  have s.to_finset.sum (λa, (s.count a : nnreal) / s.card) = 1,
    by rw [← nnreal.eq_iff, nnreal.coe_one, ← this, nnreal.sum_coe]; simp,
  begin
    rw ← this,
    apply is_sum_sum_of_ne_finset_zero,
    simp {contextual := tt},
  end⟩

def of_fintype [fintype α] (f : α → nnreal) (h : finset.univ.sum f = 1) : pmf α :=
⟨f, h ▸ is_sum_sum_of_ne_finset_zero (by simp)⟩

def bernoulli (p : nnreal) (h : p ≤ 1) : pmf bool :=
of_fintype (λb, cond b p (1 - p)) (nnreal.eq $ by simp [h])

end pmf


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.matrix.basis
import linear_algebra.basis
import linear_algebra.pi

/-!
# The standard basis

This file defines the standard basis `pi.basis (s : ∀ j, basis (ι j) R (M j))`,
which is the `Σ j, ι j`-indexed basis of Π j, M j`. The basis vectors are given by
`pi.basis s ⟨j, i⟩ j' = linear_map.std_basis R M j' (s j) i = if j = j' then s i else 0`.

The standard basis on `R^η`, i.e. `η → R` is called `pi.basis_fun`.

To give a concrete example, `linear_map.std_basis R (λ (i : fin 3), R) i 1`
gives the `i`th unit basis vector in `R³`, and `pi.basis_fun R (fin 3)` proves
this is a basis over `fin 3 → R`.

## Main definitions

 - `linear_map.std_basis R M`: if `x` is a basis vector of `M i`, then
   `linear_map.std_basis R M i x` is the `i`th standard basis vector of `Π i, M i`.
 - `pi.basis s`: given a basis `s i` for each `M i`, the standard basis on `Π i, M i`
 - `pi.basis_fun R η`: the standard basis on `R^η`, i.e. `η → R`, given by
   `pi.basis_fun R η i j = if i = j then 1 else 0`.
 - `matrix.std_basis R n m`: the standard basis on `matrix n m R`, given by
   `matrix.std_basis R n m (i, j) i' j' = if (i, j) = (i', j') then 1 else 0`.

-/

open function submodule
open_locale big_operators
open_locale big_operators

namespace linear_map

variables (R : Type*) {ι : Type*} [semiring R] (φ : ι → Type*)
  [Π i, add_comm_monoid (φ i)] [Π i, module R (φ i)] [decidable_eq ι]

/-- The standard basis of the product of `φ`. -/
def std_basis : Π (i : ι), φ i →ₗ[R] (Πi, φ i) := single

lemma std_basis_apply (i : ι) (b : φ i) : std_basis R φ i b = update 0 i b :=
rfl

lemma coe_std_basis (i : ι) : ⇑(std_basis R φ i) = pi.single i :=
rfl

@[simp] lemma std_basis_same (i : ι) (b : φ i) : std_basis R φ i b i = b :=
pi.single_eq_same i b

lemma std_basis_ne (i j : ι) (h : j ≠ i) (b : φ i) : std_basis R φ i b j = 0 :=
pi.single_eq_of_ne h b

lemma std_basis_eq_pi_diag (i : ι) : std_basis R φ i = pi (diag i) :=
begin
  ext x j,
  convert (update_apply 0 x i j _).symm,
  refl,
end

lemma ker_std_basis (i : ι) : ker (std_basis R φ i) = ⊥ :=
ker_eq_bot_of_injective $ pi.single_injective _ _

lemma proj_comp_std_basis (i j : ι) : (proj i).comp (std_basis R φ j) = diag j i :=
by rw [std_basis_eq_pi_diag, proj_pi]

lemma proj_std_basis_same (i : ι) : (proj i).comp (std_basis R φ i) = id :=
linear_map.ext $ std_basis_same R φ i

lemma proj_std_basis_ne (i j : ι) (h : i ≠ j) : (proj i).comp (std_basis R φ j) = 0 :=
linear_map.ext $ std_basis_ne R φ _ _ h

lemma supr_range_std_basis_le_infi_ker_proj (I J : set ι) (h : disjoint I J) :
  (⨆i∈I, range (std_basis R φ i)) ≤ (⨅i∈J, ker (proj i)) :=
begin
  refine (supr_le $ λ i, supr_le $ λ hi, range_le_iff_comap.2 _),
  simp only [(ker_comp _ _).symm, eq_top_iff, set_like.le_def, mem_ker, comap_infi, mem_infi],
  rintro b - j hj,
  rw [proj_std_basis_ne R φ j i, zero_apply],
  rintro rfl,
  exact h ⟨hi, hj⟩
end

lemma infi_ker_proj_le_supr_range_std_basis {I : finset ι} {J : set ι} (hu : set.univ ⊆ ↑I ∪ J) :
  (⨅ i∈J, ker (proj i)) ≤ (⨆i∈I, range (std_basis R φ i)) :=
set_like.le_def.2
begin
  assume b hb,
  simp only [mem_infi, mem_ker, proj_apply] at hb,
  rw ← show ∑ i in I, std_basis R φ i (b i) = b,
  { ext i,
    rw [finset.sum_apply, ← std_basis_same R φ i (b i)],
    refine finset.sum_eq_single i (assume j hjI ne, std_basis_ne _ _ _ _ ne.symm _) _,
    assume hiI,
    rw [std_basis_same],
    exact hb _ ((hu trivial).resolve_left hiI) },
  exact sum_mem_bsupr (λ i hi, (std_basis R φ i).mem_range_self (b i))
end

lemma supr_range_std_basis_eq_infi_ker_proj {I J : set ι}
  (hd : disjoint I J) (hu : set.univ ⊆ I ∪ J) (hI : set.finite I) :
  (⨆i∈I, range (std_basis R φ i)) = (⨅i∈J, ker (proj i)) :=
begin
  refine le_antisymm (supr_range_std_basis_le_infi_ker_proj _ _ _ _ hd) _,
  have : set.univ ⊆ ↑hI.to_finset ∪ J, { rwa [hI.coe_to_finset] },
  refine le_trans (infi_ker_proj_le_supr_range_std_basis R φ this) (supr_mono $ assume i, _),
  rw [set.finite.mem_to_finset],
  exact le_rfl
end

lemma supr_range_std_basis [fintype ι] : (⨆i:ι, range (std_basis R φ i)) = ⊤ :=
have (set.univ : set ι) ⊆ ↑(finset.univ : finset ι) ∪ ∅ := by rw [finset.coe_univ, set.union_empty],
begin
  apply top_unique,
  convert (infi_ker_proj_le_supr_range_std_basis R φ this),
  exact infi_emptyset.symm,
  exact (funext $ λi, (@supr_pos _ _ _ (λh, range (std_basis R φ i)) $ finset.mem_univ i).symm)
end

lemma disjoint_std_basis_std_basis (I J : set ι) (h : disjoint I J) :
  disjoint (⨆i∈I, range (std_basis R φ i)) (⨆i∈J, range (std_basis R φ i)) :=
begin
  refine disjoint.mono
    (supr_range_std_basis_le_infi_ker_proj _ _ _ _ $ disjoint_compl_right)
    (supr_range_std_basis_le_infi_ker_proj _ _ _ _ $ disjoint_compl_right) _,
  simp only [disjoint, set_like.le_def, mem_infi, mem_inf, mem_ker, mem_bot, proj_apply,
    funext_iff],
  rintros b ⟨hI, hJ⟩ i,
  classical,
  by_cases hiI : i ∈ I,
  { by_cases hiJ : i ∈ J,
    { exact (h ⟨hiI, hiJ⟩).elim },
    { exact hJ i hiJ } },
  { exact hI i hiI }
end

lemma std_basis_eq_single {a : R} :
  (λ (i : ι), (std_basis R (λ _ : ι, R) i) a) = λ (i : ι), (finsupp.single i a) :=
funext $ λ i, (finsupp.single_eq_pi_single i a).symm

end linear_map

namespace pi
open linear_map
open set

variables {R : Type*}

section module
variables {η : Type*} {ιs : η → Type*} {Ms : η → Type*}

lemma linear_independent_std_basis [ring R] [∀i, add_comm_group (Ms i)] [∀i, module R (Ms i)]
  [decidable_eq η] (v : Πj, ιs j → (Ms j)) (hs : ∀i, linear_independent R (v i)) :
  linear_independent R (λ (ji : Σ j, ιs j), std_basis R Ms ji.1 (v ji.1 ji.2)) :=
begin
  have hs' : ∀j : η, linear_independent R (λ i : ιs j, std_basis R Ms j (v j i)),
  { intro j,
    exact (hs j).map' _ (ker_std_basis _ _ _) },
  apply linear_independent_Union_finite hs',
  { assume j J _ hiJ,
    simp [(set.Union.equations._eqn_1 _).symm, submodule.span_image, submodule.span_Union],
    have h₀ : ∀ j, span R (range (λ (i : ιs j), std_basis R Ms j (v j i)))
        ≤ range (std_basis R Ms j),
    { intro j,
      rw [span_le, linear_map.range_coe],
      apply range_comp_subset_range },
    have h₁ : span R (range (λ (i : ιs j), std_basis R Ms j (v j i)))
        ≤ ⨆ i ∈ {j}, range (std_basis R Ms i),
    { rw @supr_singleton _ _ _ (λ i, linear_map.range (std_basis R (λ (j : η), Ms j) i)),
      apply h₀ },
    have h₂ : (⨆ j ∈ J, span R (range (λ (i : ιs j), std_basis R Ms j (v j i)))) ≤
               ⨆ j ∈ J, range (std_basis R (λ (j : η), Ms j) j) :=
      supr₂_mono (λ i _, h₀ i),
    have h₃ : disjoint (λ (i : η), i ∈ {j}) J,
    { convert set.disjoint_singleton_left.2 hiJ using 0 },
    exact (disjoint_std_basis_std_basis _ _ _ _ h₃).mono h₁ h₂ }
end

variables [semiring R] [∀i, add_comm_monoid (Ms i)] [∀i, module R (Ms i)]

variable [fintype η]

section

open linear_equiv

/-- `pi.basis (s : ∀ j, basis (ιs j) R (Ms j))` is the `Σ j, ιs j`-indexed basis on `Π j, Ms j`
given by `s j` on each component.

For the standard basis over `R` on the finite-dimensional space `η → R` see `pi.basis_fun`.
-/
protected noncomputable def basis (s : ∀ j, basis (ιs j) R (Ms j)) :
  basis (Σ j, ιs j) R (Π j, Ms j) :=
-- The `add_comm_monoid (Π j, Ms j)` instance was hard to find.
-- Defining this in tactic mode seems to shake up instance search enough that it works by itself.
by { refine basis.of_repr (_ ≪≫ₗ (finsupp.sigma_finsupp_lequiv_pi_finsupp R).symm),
     exact linear_equiv.Pi_congr_right (λ j, (s j).repr) }

@[simp] lemma basis_repr_std_basis [decidable_eq η] (s : ∀ j, basis (ιs j) R (Ms j)) (j i) :
  (pi.basis s).repr (std_basis R _ j (s j i)) = finsupp.single ⟨j, i⟩ 1 :=
begin
  ext ⟨j', i'⟩,
  by_cases hj : j = j',
  { subst hj,
    simp only [pi.basis, linear_equiv.trans_apply, basis.repr_self, std_basis_same,
        linear_equiv.Pi_congr_right_apply, finsupp.sigma_finsupp_lequiv_pi_finsupp_symm_apply],
    symmetry,
    exact basis.finsupp.single_apply_left
      (λ i i' (h : (⟨j, i⟩ : Σ j, ιs j) = ⟨j, i'⟩), eq_of_heq (sigma.mk.inj h).2) _ _ _ },
  simp only [pi.basis, linear_equiv.trans_apply, finsupp.sigma_finsupp_lequiv_pi_finsupp_symm_apply,
      linear_equiv.Pi_congr_right_apply],
  dsimp,
  rw [std_basis_ne _ _ _ _ (ne.symm hj), linear_equiv.map_zero, finsupp.zero_apply,
      finsupp.single_eq_of_ne],
  rintros ⟨⟩,
  contradiction
end

@[simp] lemma basis_apply [decidable_eq η] (s : ∀ j, basis (ιs j) R (Ms j)) (ji) :
  pi.basis s ji = std_basis R _ ji.1 (s ji.1 ji.2) :=
basis.apply_eq_iff.mpr (by simp)

@[simp] lemma basis_repr (s : ∀ j, basis (ιs j) R (Ms j)) (x) (ji) :
  (pi.basis s).repr x ji = (s ji.1).repr (x ji.1) ji.2 :=
rfl

end

section
variables (R η)

/-- The basis on `η → R` where the `i`th basis vector is `function.update 0 i 1`. -/
noncomputable def basis_fun : basis η R (Π (j : η), R) :=
basis.of_equiv_fun (linear_equiv.refl _ _)

@[simp] lemma basis_fun_apply [decidable_eq η] (i) :
  basis_fun R η i = std_basis R (λ (i : η), R) i 1 :=
by { simp only [basis_fun, basis.coe_of_equiv_fun, linear_equiv.refl_symm,
                linear_equiv.refl_apply, std_basis_apply],
     congr /- Get rid of a `decidable_eq` mismatch. -/ }

@[simp] lemma basis_fun_repr (x : η → R) (i : η) :
  (pi.basis_fun R η).repr x i = x i :=
by simp [basis_fun]

end

end module

end pi

namespace matrix

variables (R : Type*) (m n : Type*) [fintype m] [fintype n] [semiring R]

/-- The standard basis of `matrix m n R`. -/
noncomputable def std_basis : basis (m × n) R (matrix m n R) :=
basis.reindex (pi.basis (λ (i : m), pi.basis_fun R n)) (equiv.sigma_equiv_prod _ _)

variables {n m}

lemma std_basis_eq_std_basis_matrix (i : n) (j : m) [decidable_eq n] [decidable_eq m] :
  std_basis R n m (i, j) = std_basis_matrix i j (1 : R) :=
begin
  ext a b,
  by_cases hi : i = a; by_cases hj : j = b,
  { simp [std_basis, hi, hj] },
  { simp [std_basis, hi, hj, ne.symm hj, linear_map.std_basis_ne] },
  { simp [std_basis, hi, hj, ne.symm hi, linear_map.std_basis_ne] },
  { simp [std_basis, hi, hj, ne.symm hj, ne.symm hi, linear_map.std_basis_ne] }
end

end matrix


/-
Copyright (c) 2020 Filippo A. E. Nuccio. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Filippo A. E. Nuccio, Andrew Yang

! This file was ported from Lean 3 source module algebraic_geometry.prime_spectrum.noetherian
! leanprover-community/mathlib commit 052f6013363326d50cb99c6939814a4b8eb7b301
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicGeometry.PrimeSpectrum.Basic
import Mathbin.Topology.NoetherianSpace

/-!
This file proves additional properties of the prime spectrum a ring is Noetherian.
-/

universe u v

namespace PrimeSpectrum

open Submodule

variable (R : Type u) [CommRing R] [IsNoetherianRing R]

variable {A : Type u} [CommRing A] [IsDomain A] [IsNoetherianRing A]

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (z «expr ∉ » M) -/
/-- In a noetherian ring, every ideal contains a product of prime ideals
([samuel, § 3.3, Lemma 3])-/
theorem exists_primeSpectrum_prod_le (I : Ideal R) :
    ∃ Z : Multiset (PrimeSpectrum R), Multiset.prod (Z.map asIdeal) ≤ I :=
  by
  refine' IsNoetherian.induction (fun (M : Ideal R) hgt => _) I
  by_cases h_prM : M.is_prime
  · use {⟨M, h_prM⟩}
    rw [Multiset.map_singleton, Multiset.prod_singleton]
    exact le_rfl
  by_cases htop : M = ⊤
  · rw [htop]
    exact ⟨0, le_top⟩
  have lt_add : ∀ (z) (_ : z ∉ M), M < M + span R {z} :=
    by
    intro z hz
    refine' lt_of_le_of_ne le_sup_left fun m_eq => hz _
    rw [m_eq]
    exact Ideal.mem_sup_right (mem_span_singleton_self z)
  obtain ⟨x, hx, y, hy, hxy⟩ := (ideal.not_is_prime_iff.mp h_prM).resolve_left htop
  obtain ⟨Wx, h_Wx⟩ := hgt (M + span R {x}) (lt_add _ hx)
  obtain ⟨Wy, h_Wy⟩ := hgt (M + span R {y}) (lt_add _ hy)
  use Wx + Wy
  rw [Multiset.map_add, Multiset.prod_add]
  apply le_trans (Submodule.mul_le_mul h_Wx h_Wy)
  rw [add_mul]
  apply sup_le (show M * (M + span R {y}) ≤ M from Ideal.mul_le_right)
  rw [mul_add]
  apply sup_le (show span R {x} * M ≤ M from Ideal.mul_le_left)
  rwa [span_mul_span, Set.singleton_mul_singleton, span_singleton_le_iff_mem]
#align prime_spectrum.exists_prime_spectrum_prod_le PrimeSpectrum.exists_primeSpectrum_prod_le

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (z «expr ∉ » M) -/
/-- In a noetherian integral domain which is not a field, every non-zero ideal contains a non-zero
  product of prime ideals; in a field, the whole ring is a non-zero ideal containing only 0 as
  product or prime ideals ([samuel, § 3.3, Lemma 3]) -/
theorem exists_primeSpectrum_prod_le_and_ne_bot_of_domain (h_fA : ¬IsField A) {I : Ideal A}
    (h_nzI : I ≠ ⊥) :
    ∃ Z : Multiset (PrimeSpectrum A),
      Multiset.prod (Z.map asIdeal) ≤ I ∧ Multiset.prod (Z.map asIdeal) ≠ ⊥ :=
  by
  revert h_nzI
  refine' IsNoetherian.induction (fun (M : Ideal A) hgt => _) I
  intro h_nzM
  have hA_nont : Nontrivial A
  apply IsDomain.to_nontrivial A
  by_cases h_topM : M = ⊤
  · rcases h_topM with rfl
    obtain ⟨p_id, h_nzp, h_pp⟩ : ∃ p : Ideal A, p ≠ ⊥ ∧ p.IsPrime := by
      apply ring.not_is_field_iff_exists_prime.mp h_fA
    use ({⟨p_id, h_pp⟩} : Multiset (PrimeSpectrum A)), le_top
    rwa [Multiset.map_singleton, Multiset.prod_singleton]
  by_cases h_prM : M.is_prime
  · use ({⟨M, h_prM⟩} : Multiset (PrimeSpectrum A))
    rw [Multiset.map_singleton, Multiset.prod_singleton]
    exact ⟨le_rfl, h_nzM⟩
  obtain ⟨x, hx, y, hy, h_xy⟩ := (ideal.not_is_prime_iff.mp h_prM).resolve_left h_topM
  have lt_add : ∀ (z) (_ : z ∉ M), M < M + span A {z} :=
    by
    intro z hz
    refine' lt_of_le_of_ne le_sup_left fun m_eq => hz _
    rw [m_eq]
    exact mem_sup_right (mem_span_singleton_self z)
  obtain ⟨Wx, h_Wx_le, h_Wx_ne⟩ := hgt (M + span A {x}) (lt_add _ hx) (ne_bot_of_gt (lt_add _ hx))
  obtain ⟨Wy, h_Wy_le, h_Wx_ne⟩ := hgt (M + span A {y}) (lt_add _ hy) (ne_bot_of_gt (lt_add _ hy))
  use Wx + Wy
  rw [Multiset.map_add, Multiset.prod_add]
  refine' ⟨le_trans (Submodule.mul_le_mul h_Wx_le h_Wy_le) _, mt ideal.mul_eq_bot.mp _⟩
  · rw [add_mul]
    apply sup_le (show M * (M + span A {y}) ≤ M from Ideal.mul_le_right)
    rw [mul_add]
    apply sup_le (show span A {x} * M ≤ M from Ideal.mul_le_left)
    rwa [span_mul_span, Set.singleton_mul_singleton, span_singleton_le_iff_mem]
  · rintro (hx | hy) <;> contradiction
#align prime_spectrum.exists_prime_spectrum_prod_le_and_ne_bot_of_domain PrimeSpectrum.exists_primeSpectrum_prod_le_and_ne_bot_of_domain

open TopologicalSpace

instance : NoetherianSpace (PrimeSpectrum R) :=
  by
  rw [(noetherian_space_tfae <| PrimeSpectrum R).out 0 1]
  have H := ‹IsNoetherianRing R›
  rw [isNoetherianRing_iff, isNoetherian_iff_wellFounded] at H
  exact (closeds_embedding R).dual.WellFounded H

end PrimeSpectrum