import data.equiv

universes u v w

class transportable (f : Type u → Type v) :=
(on_equiv : Π {α β : Type u} (e : equiv α β), equiv (f α) (f β))
(on_refl  : Π (α : Type u), on_equiv (equiv.refl α) = equiv.refl (f α))
(on_trans : Π {α β γ : Type u} (d : equiv α β) (e : equiv β γ), on_equiv (equiv.trans d e) = equiv.trans (on_equiv d) (on_equiv e))

local attribute [simp] transportable.on_refl transportable.on_trans

-- Our goal is an automagic proof of the following (level 20)
theorem group.transportable : transportable group := sorry

def transportable.trans (f : Type u → Type v) (g : Type v → Type w)
  [transportable f] [transportable g] : transportable (g ∘ f) :=
{ on_equiv := λ α β e, show g (f α) ≃ g (f β), from transportable.on_equiv g (transportable.on_equiv f e),
  on_refl  := λ α, by simp,
  on_trans := λ α β γ e₁ e₂, by simp }

-- These we might need to define and prove by hand
def Const : Type u → Type v := λ α, punit
def Fun : Type u → Type v → Type (max u v) := λ α β, α → β
def Prod : Type u → Type v → Type (max u v) := λ α β, α × β
def Swap : Type u → Type v → Type (max u v) := λ α β, β × α

-- level 1
lemma Const.transportable : (transportable Const) :=
{ on_equiv := λ α β e, equiv.punit_equiv_punit,
  on_refl  := λ α, equiv.ext _ _ $ λ ⟨⟩, rfl,
  on_trans := λ α β γ e1 e2, equiv.ext _ _ $ λ ⟨⟩, rfl }

lemma Fun.transportable (α : Type u) : (transportable (Fun α)) :=
{ on_equiv := λ β γ e, equiv.arrow_congr (equiv.refl α) e,
  on_refl  := λ β, equiv.ext _ _ $ λ f, rfl,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

theorem prod.ext' {α β : Type*} {p q : α × β} (H1 : p.1 = q.1) (H2 : p.2 = q.2) : p = q :=
prod.ext.2 ⟨H1, H2⟩

lemma Prod.transportable (α : Type u) : (transportable (Prod α)) :=
{ on_equiv := λ β γ e, equiv.prod_congr (equiv.refl α) e,
  on_refl  := λ β, equiv.ext _ _ $ λ ⟨x, y⟩, by simp,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ ⟨x, y⟩, by simp }

lemma Swap.transportable (α : Type u) : (transportable (Swap α)) :=
{ on_equiv := λ β γ e, equiv.prod_congr e (equiv.refl α),
  on_refl  := λ β, equiv.ext _ _ $ λ ⟨x, y⟩, by simp,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ ⟨x, y⟩, by simp }

-- And then we can define
def Hom1 (α : Type u) : Type v → Type (max u v) := λ β, α → β
def Hom2 (β : Type v) : Type u → Type (max u v) := λ α, α → β
def Aut : Type u → Type u := λ α, α → α

-- And hopefully automagically derive
lemma Hom1.transportable (α : Type u) : (transportable (Hom1 α)) :=
Fun.transportable α

lemma Hom2.transportable (β : Type v) : (transportable (Hom2 β)) :=
{ on_equiv := λ α γ e, equiv.arrow_congr e (equiv.refl β),
  on_refl  := λ β, equiv.ext _ _ $ λ f, rfl,
  on_trans := λ β γ δ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

lemma Aut.transportable : (transportable Aut) :=
{ on_equiv := λ α β e, equiv.arrow_congr e e,
  on_refl  := λ α, equiv.ext _ _ $ λ f, funext $ λ x, rfl,
  on_trans := λ α β γ e1 e2, equiv.ext _ _ $ λ f, funext $ λ x,
    by cases e1; cases e2; refl }

-- If we have all these in place...
-- A bit of magic might actually be able to derive `group.transportable` on line 11.
-- After all, a group just is a type plus some functions... and we can now transport functions.


import data.finsupp
import algebra.ring
import .to_finset
import .to_multiset
import associated_quotient
import unique_factorization_domain

noncomputable theory

local infix ^ := monoid.pow

open classical multiset
local attribute [instance] prop_decidable

universe u
variable {α : Type u}

--Would it have been smart to define units as a type that lives in Prop??
--Or would this have been pointless because a Prop cannot contain data? It could have been made with exisential quatifier, but than we are in the same situation that we are in now.

/-
lemma is_unit_unit {t : Type u}[h : semiring t] (u : units t) : @is_unit t h u :=
⟨u, rfl⟩
-/
open associated

--can the priority be set better? Because now we often have to provide parentheses
local notation a `~ᵤ` b : 50 := associated a b

lemma for_all_is_unit_of_not_zero [field α] : ∀{x : α}, x ≠ 0 → is_unit x :=
begin
  assume x h1,
  rw [is_unit],
  fapply exists.intro,
  {
    exact ⟨x, x⁻¹, mul_inv_cancel h1, inv_mul_cancel h1⟩
  },
  {
    refl
  }
end

lemma for_all_not_irreducible [field α] : ∀{x : α}, ¬irreducible x :=
begin
  {
    simp [irreducible],
    intros x h1 h2,
    have : is_unit x,
    from for_all_is_unit_of_not_zero h1,
    contradiction
  }
end

lemma eq_empty_of_forall_irreducible_of_mem [field α] {g : multiset α}: (∀ (x : α), x ∈ g → irreducible x) → g = ∅ :=
begin
  intro h1,
  by_cases h2 : (g = ∅),
  exact h2,
  {
       let x := some (multiset.exists_mem_of_ne_zero h2),
       have h3 : x ∈ g,
       from some_spec (multiset.exists_mem_of_ne_zero h2),
       have h4 : irreducible x,
       from h1 x h3,
       have : ¬ irreducible x,
       from for_all_not_irreducible,
       contradiction
  }
end

--Why placed here?
instance field.to_unique_factorization_domain [s : field α] : unique_factorization_domain α :=
{
    eq_zero_or_eq_zero_of_mul_eq_zero := @eq_zero_or_eq_zero_of_mul_eq_zero _ _, --Problem, will it now use the same as integral domain or again diamond problem?
    fac :=
    begin
      assume x h1 h2,
      have : is_unit x,
      from for_all_is_unit_of_not_zero h1,
      contradiction
    end,
    unique :=
    begin
      intros f g h1 h2 h3,
      have hf : f = ∅,
      from eq_empty_of_forall_irreducible_of_mem h1,
      have hg : g = ∅,
      from eq_empty_of_forall_irreducible_of_mem h2,
      rw [hf, hg],
      simp [rel_multiset.nil]
    end,
    ..s
}


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

import category_theory.idempotents.karoubi
import category_theory.additive.basic

/-!

# Biproducts in the idempotent completion of a preadditive category

In this file, we define an instance expressing that if `C` is an additive category,
then `karoubi C` is also an additive category.

We also obtain that for all `P : karoubi C` where `C` is a preadditive category `C`, there
is a canonical isomorphism `P ⊞ P.complement ≅ (to_karoubi C).obj P.X` in the category
`karoubi C` where `P.complement` is the formal direct factor of `P.X` corresponding to
the idempotent endomorphism `𝟙 P.X - P.p`.

-/

noncomputable theory

open category_theory.category
open category_theory.limits
open category_theory.preadditive

universes v

namespace category_theory

namespace idempotents

namespace karoubi

variables {C : Type*} [category.{v} C] [preadditive C]

namespace biproducts

/-- The `bicone` used in order to obtain the existence of
the biproduct of a functor `J ⥤ karoubi C` when the category `C` is additive. -/
@[simps]
def bicone [has_finite_biproducts C] {J : Type} [fintype J]
  (F : J → karoubi C) : bicone F :=
{ X :=
  { X := biproduct (λ j, (F j).X),
    p := biproduct.map (λ j, (F j).p),
    idem := begin
      ext j,
      simp only [biproduct.ι_map_assoc, biproduct.ι_map],
      slice_lhs 1 2 { rw (F j).idem, },
    end, },
  π := λ j,
    { f := biproduct.map (λ j, (F j).p) ≫ bicone.π _ j,
      comm := by simp only [assoc, biproduct.bicone_π, biproduct.map_π,
        biproduct.map_π_assoc, (F j).idem], },
  ι := λ j,
    { f := (by exact bicone.ι _ j) ≫ biproduct.map (λ j, (F j).p),
      comm := by rw [biproduct.ι_map, ← assoc, ← assoc, (F j).idem,
        assoc, biproduct.ι_map, ← assoc, (F j).idem], },
  ι_π := λ j j', begin
    split_ifs,
    { subst h,
      simp only [biproduct.bicone_ι, biproduct.ι_map, biproduct.bicone_π,
        biproduct.ι_π_self_assoc, comp, category.assoc, eq_to_hom_refl, id_eq,
        biproduct.map_π, (F j).idem], },
    { simpa only [hom_ext, biproduct.ι_π_ne_assoc _ h, assoc,
        biproduct.map_π, biproduct.map_π_assoc, zero_comp, comp], },
  end, }

end biproducts

lemma karoubi_has_finite_biproducts [has_finite_biproducts C] :
  has_finite_biproducts (karoubi C) :=
{ has_biproducts_of_shape := λ J hJ,
  { has_biproduct := λ F, begin
      classical,
      letI := hJ,
      apply has_biproduct_of_total (biproducts.bicone F),
      ext1, ext1,
      simp only [id_eq, comp_id, biproducts.bicone_X_p, biproduct.ι_map],
      rw [sum_hom, comp_sum, finset.sum_eq_single j], rotate,
      { intros j' h1 h2,
        simp only [biproduct.ι_map, biproducts.bicone_ι_f, biproducts.bicone_π_f,
          assoc, comp, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs,
        { exfalso, exact h2 h.symm, },
        { simp only [zero_comp], } },
      { intro h,
        exfalso,
        simpa only [finset.mem_univ, not_true] using h, },
      { simp only [biproducts.bicone_π_f, comp,
          biproduct.ι_map, assoc, biproducts.bicone_ι_f, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs, swap, { exfalso, exact h rfl, },
        simp only [eq_to_hom_refl, id_comp, (F j).idem], },
    end, } }

instance {D : Type*} [category D] [additive_category D] : additive_category (karoubi D) :=
{ to_preadditive := infer_instance,
  to_has_finite_biproducts := karoubi_has_finite_biproducts }

/-- `P.complement` is the formal direct factor of `P.X` given by the idempotent
endomorphism `𝟙 P.X - P.p` -/
@[simps]
def complement (P : karoubi C) : karoubi C :=
{ X := P.X,
  p := 𝟙 _ - P.p,
  idem := idem_of_id_sub_idem P.p P.idem, }

instance (P : karoubi C) : has_binary_biproduct P P.complement :=
has_binary_biproduct_of_total
{ X := P.X,
  fst := P.decomp_id_p,
  snd := P.complement.decomp_id_p,
  inl := P.decomp_id_i,
  inr := P.complement.decomp_id_i,
  inl_fst' := P.decomp_id.symm,
  inl_snd' := begin
    simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [comp_id, sub_self],
  end,
  inr_fst' := begin
    simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [id_comp, sub_self],
  end,
  inr_snd' := P.complement.decomp_id.symm, }
(by simp only [hom_ext, ← decomp_p, quiver.hom.add_comm_group_add_f,
  to_karoubi_map_f, id_eq, coe_p, complement_p, add_sub_cancel'_right])

/-- A formal direct factor `P : karoubi C` of an object `P.X : C` in a
preadditive category is actually a direct factor of the image `(to_karoubi C).obj P.X`
of `P.X` in the category `karoubi C` -/
def decomposition (P : karoubi C) : P ⊞ P.complement ≅ (to_karoubi _).obj P.X :=
{ hom := biprod.desc P.decomp_id_i P.complement.decomp_id_i,
  inv := biprod.lift P.decomp_id_p P.complement.decomp_id_p,
  hom_inv_id' := begin
    ext1,
    { simp only [← assoc, biprod.inl_desc, comp_id, biprod.lift_eq, comp_add,
        ← decomp_id, id_comp, add_right_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [comp_id, sub_self], },
    { simp only [← assoc, biprod.inr_desc, biprod.lift_eq, comp_add,
        ← decomp_id, comp_id, id_comp, add_left_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [id_comp, sub_self], }
  end,
  inv_hom_id' := begin
    rw biprod.lift_desc,
    simp only [← decomp_p],
    ext,
    dsimp only [complement, to_karoubi],
    simp only [quiver.hom.add_comm_group_add_f, add_sub_cancel'_right, id_eq],
  end, }

end karoubi

end idempotents

end category_theory


/-
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_numbertheory_3 :
  (∑ x in finset.range 10, ((x + 1)^2)) % 10 = 5 :=
begin
  dec_trivial!,
end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Ring.basic
import topology.category.Top.basic
import topology.algebra.ring.basic

/-!
# Category of topological commutative rings

We introduce the category `TopCommRing` of topological commutative rings together with the relevant
forgetful functors to topological spaces and commutative rings.
-/

universes u

open category_theory

/-- A bundled topological commutative ring. -/
structure TopCommRing :=
(α : Type u)
[is_comm_ring : comm_ring α]
[is_topological_space : topological_space α]
[is_topological_ring : topological_ring α]

namespace TopCommRing

instance : inhabited TopCommRing := ⟨⟨punit⟩⟩

instance : has_coe_to_sort TopCommRing (Type u) := ⟨TopCommRing.α⟩

attribute [instance] is_comm_ring is_topological_space is_topological_ring

instance : category TopCommRing.{u} :=
{ hom   := λ R S, {f : R →+* S // continuous f },
  id    := λ R, ⟨ring_hom.id R, by obviously⟩, -- TODO remove obviously?
  comp  := λ R S T f g, ⟨g.val.comp f.val,
    begin -- TODO automate
      cases f, cases g,
      dsimp, apply continuous.comp ; assumption
    end⟩ }

instance : concrete_category TopCommRing.{u} :=
{ forget := { obj := λ R, R, map := λ R S f, f.val },
  forget_faithful := { } }

/-- Construct a bundled `TopCommRing` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] : TopCommRing := ⟨X⟩

@[simp] lemma coe_of (X : Type u) [comm_ring X] [topological_space X] [topological_ring X] :
  (of X : Type u) = X := rfl

instance forget_topological_space (R : TopCommRing) :
  topological_space ((forget TopCommRing).obj R) :=
R.is_topological_space
instance forget_comm_ring (R : TopCommRing) :
  comm_ring ((forget TopCommRing).obj R) :=
R.is_comm_ring
instance forget_topological_ring (R : TopCommRing) :
  topological_ring ((forget TopCommRing).obj R) :=
R.is_topological_ring

instance has_forget_to_CommRing : has_forget₂ TopCommRing CommRing :=
has_forget₂.mk'
  (λ R, CommRing.of R)
  (λ x, rfl)
  (λ R S f, f.val)
  (λ R S f, heq.rfl)

instance forget_to_CommRing_topological_space (R : TopCommRing) :
  topological_space ((forget₂ TopCommRing CommRing).obj R) :=
R.is_topological_space

/-- The forgetful functor to Top. -/
instance has_forget_to_Top : has_forget₂ TopCommRing Top :=
has_forget₂.mk'
  (λ R, Top.of R)
  (λ x, rfl)
  (λ R S f, ⟨⇑f.1, f.2⟩)
  (λ R S f, heq.rfl)

instance forget_to_Top_comm_ring (R : TopCommRing) :
  comm_ring ((forget₂ TopCommRing Top).obj R) :=
R.is_comm_ring

instance forget_to_Top_topological_ring (R : TopCommRing) :
  topological_ring ((forget₂ TopCommRing Top).obj R) :=
R.is_topological_ring

/--
The forgetful functors to `Type` do not reflect isomorphisms,
but the forgetful functor from `TopCommRing` to `Top` does.
-/
instance : reflects_isomorphisms (forget₂ TopCommRing.{u} Top.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    -- We have an isomorphism in `Top`,
    let i_Top := as_iso ((forget₂ TopCommRing Top).map f),

    -- and a `ring_equiv`.
    let e_Ring : X ≃+* Y := { ..f.1, ..((forget Top).map_iso i_Top).to_equiv },

    -- Putting these together we obtain the isomorphism we're after:
    exact
    ⟨⟨⟨e_Ring.symm, i_Top.inv.2⟩,
      ⟨by { ext x, exact e_Ring.left_inv x, }, by { ext x, exact e_Ring.right_inv x, }⟩⟩⟩
  end }

end TopCommRing


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

! This file was ported from Lean 3 source module category_theory.balanced
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.EpiMono

/-!
# Balanced categories

A category is called balanced if any morphism that is both monic and epic is an isomorphism.

Balanced categories arise frequently. For example, categories in which every monomorphism
(or epimorphism) is strong are balanced. Examples of this are abelian categories and toposes, such
as the category of types.

-/

universe v u

namespace CategoryTheory

variable {C : Type u} [Category.{v} C]

section

variable (C)

/-- A category is called balanced if any morphism that is both monic and epic is an isomorphism. -/
class Balanced : Prop where
  isIso_of_mono_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [Mono f] [Epi f], IsIso f
#align category_theory.balanced CategoryTheory.Balanced

end

theorem isIso_of_mono_of_epi [Balanced C] {X Y : C} (f : X ⟶ Y) [Mono f] [Epi f] : IsIso f :=
  Balanced.isIso_of_mono_of_epi _
#align category_theory.is_iso_of_mono_of_epi CategoryTheory.isIso_of_mono_of_epi

theorem isIso_iff_mono_and_epi [Balanced C] {X Y : C} (f : X ⟶ Y) : IsIso f ↔ Mono f ∧ Epi f :=
  ⟨fun _ => ⟨inferInstance, inferInstance⟩, fun ⟨_, _⟩ => isIso_of_mono_of_epi _⟩
#align category_theory.is_iso_iff_mono_and_epi CategoryTheory.isIso_iff_mono_and_epi

section

attribute [local instance] isIso_of_mono_of_epi

theorem balanced_opposite [Balanced C] : Balanced Cᵒᵖ :=
  { isIso_of_mono_of_epi := fun f fmono fepi => by
      rw [← Quiver.Hom.op_unop f]
      exact isIso_of_op _ }
#align category_theory.balanced_opposite CategoryTheory.balanced_opposite

end

end CategoryTheory


import data.real.cau_seq
import algebra.big_operators.basic
import algebra.big_operators.ring

import valuations.basic
import for_mathlib.specific_limits

open is_absolute_value
open_locale classical big_operators

lemma absolute_value_units_bounded {α} [ring α] [nontrivial α]
  (abv: α → ℝ) [is_absolute_value abv]
  (bounded: ∀ a: α, abv a ≤ 1): ∀ u: units α, abv u = 1 :=
begin
  intro u,
  by_contra h,
  have abvc_lt_one: abv u.val < 1 := lt_of_le_of_ne (bounded u) h,
  have prod_eq: abv u.val * abv u.inv = 1 * 1,
  by rw [← abv_mul abv, u.val_inv, abv_one abv, one_mul],
  have prod_lt: abv u.val * abv u.inv < 1 * 1,
  {
    have: u.inv ≠ 0,
    {
      intro h,
      have := u.val_inv,
      rw [h, mul_zero] at this,
      exact zero_ne_one this,
    },
    exact mul_lt_mul abvc_lt_one (bounded u.inv)
      ((abv_pos abv).2 this) zero_le_one,
  },
  exact (ne_of_lt prod_lt) prod_eq,
end

theorem nonarchimedian_iff_integers_bounded
  {α} [comm_ring α] [nontrivial α] (abv: α → ℝ) [is_absolute_value abv]:
  (∃ C: ℝ, 0 < C ∧ ∀ n: ℕ, abv n ≤ C) ↔ (∀ a b: α, abv (a + b) ≤ max (abv a) (abv b)) :=
begin
  split,
  {
    rintros ⟨ C, h ⟩ a b,
    have max_nonneg: 0 ≤ max (abv a) (abv b),
    from le_trans (abv_nonneg abv a) (le_max_left _ _),

    have: ∀ n: ℕ, abv (a + b) ^ n ≤ C * (n + 1) * (max (abv a) (abv b) ^ n),
    {
      intro n,

      have p₁: ∀ m ≤ n, abv (a^m * b^(n - m) * nat.choose n m)
        ≤ C * (max (abv a) (abv b) ^ n),
      {
        intros m hm,
        simp only [abv_mul abv, abv_pow abv],

        have p₁: abv a ^ m ≤ (max (abv a) (abv b)) ^ m,
        from pow_le_pow_of_le_left (abv_nonneg abv a) (le_max_left _ _) _,
        have p₂: abv b ^ (n - m) ≤ (max (abv a) (abv b)) ^ (n - m),
        from pow_le_pow_of_le_left (abv_nonneg abv b) (le_max_right _ _) _,
        have p₃: abv (nat.choose n m) ≤ C,
        from h.2 _,

        calc abv a ^ m * abv b ^ (n - m) * abv (nat.choose n m)
          ≤ max (abv a) (abv b) ^ m * max (abv a) (abv b) ^ (n - m) * C
            : by {
              refine mul_le_mul
                (mul_le_mul p₁ p₂ (pow_nonneg (abv_nonneg abv _) _) _)
                p₃ (abv_nonneg abv _)
                (mul_nonneg _ _); exact pow_nonneg max_nonneg _,
            }
          ... = (max (abv a) (abv b) ^ n) * C
            : by { rw ← pow_add, congr, exact nat.add_sub_cancel' hm, }
          ... = C * (max (abv a) (abv b) ^ n)
            : by ring,
      },

      calc abv (a + b) ^ n = abv ((a + b) ^ n) : eq.symm (abv_pow abv _ _)
        ... = abv (∑ (m: ℕ) in finset.range (n + 1), a^m * b^(n - m) * nat.choose n m)
          : by { rw add_pow a b n, }
        ... ≤ ∑ (m: ℕ) in finset.range (n + 1), abv (a^m * b^(n - m) * nat.choose n m)
          : abv_sum_le_sum_abv _ _
        ... ≤ ∑ (m: ℕ) in finset.range (n + 1), C * (max (abv a) (abv b) ^ n)
          : by {
            refine finset.sum_le_sum (λ m hm, p₁ m _),
            rw finset.mem_range at hm,
            linarith only [hm],
          }
        ... = C * ∑ (m: ℕ) in finset.range (n + 1), (max (abv a) (abv b) ^ n)
          : eq.symm finset.mul_sum
        ... = C * (n + 1) * (max (abv a) (abv b) ^ n)
          : by { simp, rw mul_assoc, },
    },

    suffices h₁: ∀ n: ℕ, (abv (a + b) ^ (n: ℝ)) ^ (1/n: ℝ)
      ≤ (C * (n + 1) * (max (abv a) (abv b) ^ (n: ℝ))) ^ (1/n: ℝ),
    {
      have: ∀ n: ℕ, 0 < n → abv (a + b) ≤
        (C * (n + 1)) ^ (1/n: ℝ) * (max (abv a) (abv b)),
      {
        intros n hn,
        specialize h₁ n,
        rw ← real.rpow_mul (abv_nonneg abv (a + b)) _ _ at h₁,
        rw real.mul_rpow
          (mul_nonneg (le_of_lt h.1)
            (show 0 ≤ (n:ℝ) + 1, by { norm_cast, linarith, }))
          (real.rpow_nonneg_of_nonneg max_nonneg n) at h₁,
        rw ← real.rpow_mul max_nonneg _ _ at h₁,
        rw mul_one_div_cancel (show (n: ℝ) ≠ 0,
          by { norm_cast, exact ne.symm (ne_of_lt hn), } ) at h₁,
        repeat { rw real.rpow_one at h₁, },
        exact h₁,
      },
      have lim₀: filter.tendsto (λ n: ℕ, (C * (n + 1)) ^ (1/n: ℝ)) filter.at_top (nhds 1) := tendsto_comparison_at_top_nhds_1_of_pos h.1,
      have lim₁: filter.tendsto (λ n: ℕ, abv (a + b)) filter.at_top (nhds (abv (a + b))),
      { exact tendsto_const_nhds, },
      have lim₂: filter.tendsto
        (λ n: ℕ, (C * (n + 1)) ^ (1/n: ℝ) * (max (abv a) (abv b)))
        filter.at_top (nhds (max (abv a) (abv b))),
      {
        convert filter.tendsto.mul_const (max (abv a) (abv b)) lim₀,
        rw one_mul,
      },

      apply le_of_tendsto_of_tendsto lim₁ lim₂,
      simp only [filter.eventually_le, filter.eventually_at_top],
      exact ⟨ 1, λ n, this n ⟩,
    },

    intro n,
    specialize this n,
    simp only [real.rpow_nat_cast],

    have low_bound: 0 ≤ C * (n + 1: ℝ) * max (abv a) (abv b) ^ n,
    from mul_nonneg (mul_nonneg (le_of_lt h.1)
      (by { norm_cast, simp, })) (pow_nonneg max_nonneg n),

    apply_fun (λ x: ℝ, (max 0 x) ^ (1/n: ℝ)) at this,
    simp only [abv_nonneg abv (a + b), low_bound, max_eq_right, pow_nonneg] at this,
    exact this,
    intros x y hxy,
    dsimp,
    apply real.rpow_le_rpow
      (le_max_left _ _) (max_le_max (le_refl 0) (hxy))
      (one_div_nonneg.2 $ nat.cast_nonneg n),
  },
  {
    intro h,
    use [1, zero_lt_one],
    intro n,
    induction n with n hn,
    simp [abv_zero abv, zero_le_one],
    rw ← nat.add_one,
    push_cast,
    calc abv (n + 1) ≤ max (abv n) (abv 1) : h n 1
      ... ≤ max 1 1 : max_le_max hn (by { rw abv_one abv, })
      ... = 1 : by simp,
  },
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.equiv.set

/-!
# Small types

A type is `w`-small if there exists an equivalence to some `S : Type w`.

We provide a noncomputable model `shrink α : Type w`, and `equiv_shrink α : α ≃ shrink α`.

A subsingleton type is `w`-small for any `w`.

If `α ≃ β`, then `small.{w} α ↔ small.{w} β`.
-/

universes u w v

/--
A type is `small.{w}` if there exists an equivalence to some `S : Type w`.
-/
class small (α : Type v) : Prop :=
(equiv_small : ∃ (S : Type w), nonempty (α ≃ S))

/--
Constructor for `small α` from an explicit witness type and equivalence.
-/
lemma small.mk' {α : Type v} {S : Type w} (e : α ≃ S) : small.{w} α :=
⟨⟨S, ⟨e⟩⟩⟩

/--
An arbitrarily chosen model in `Type w` for a `w`-small type.
-/
@[nolint has_inhabited_instance]
def shrink (α : Type v) [small.{w} α] : Type w :=
classical.some (@small.equiv_small α _)

/--
The noncomputable equivalence between a `w`-small type and a model.
-/
noncomputable
def equiv_shrink (α : Type v) [small.{w} α] : α ≃ shrink α :=
nonempty.some (classical.some_spec (@small.equiv_small α _))

@[priority 100]
instance small_self (α : Type v) : small.{v} α :=
small.mk' (equiv.refl _)

@[priority 100]
instance small_max (α : Type v) : small.{max w v} α :=
small.mk' equiv.ulift.{w}.symm

instance small_ulift (α : Type v) : small.{v} (ulift.{w} α) :=
small.mk' equiv.ulift

theorem small_type : small.{max (u+1) v} (Type u) := small_max.{max (u+1) v} _

section
open_locale classical

theorem small_congr {α : Type*} {β : Type*} (e : α ≃ β) : small.{w} α ↔ small.{w} β :=
begin
  fsplit,
  { rintro ⟨S, ⟨f⟩⟩,
    exact small.mk' (e.symm.trans f), },
  { rintro ⟨S, ⟨f⟩⟩,
    exact small.mk' (e.trans f), },
end

instance small_subtype (α : Type v) [small.{w} α] (P : α → Prop) : small.{w} { x // P x } :=
begin
  rw small_congr (equiv_shrink α).subtype_equiv_of_subtype',
  apply_instance,
end

theorem small_of_injective {α : Type*} {β : Type*} [small.{w} β]
  (f : α → β) (hf : function.injective f) : small.{w} α :=
begin
  rw small_congr (equiv.of_injective f hf),
  apply_instance,
end

@[priority 100]
instance small_subsingleton (α : Type v) [subsingleton α] : small.{w} α :=
begin
  rcases is_empty_or_nonempty α; resetI,
  { rw small_congr (equiv.equiv_pempty α), apply small_self, },
  { rw small_congr equiv.punit_of_nonempty_of_subsingleton,
    apply small_self, assumption, assumption, },
end

/-!
We don't define `small_of_fintype` or `small_of_encodable` in this file,
to keep imports to `logic` to a minimum.
-/

instance small_Pi {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
  small.{w} (Π a, β a) :=
⟨⟨Π a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
  ⟨equiv.Pi_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩

instance small_sigma {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
  small.{w} (Σ a, β a) :=
⟨⟨Σ a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
  ⟨equiv.sigma_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩

instance small_prod {α β} [small.{w} α] [small.{w} β] : small.{w} (α × β) :=
⟨⟨shrink α × shrink β,
  ⟨equiv.prod_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩

instance small_sum {α β} [small.{w} α] [small.{w} β] : small.{w} (α ⊕ β) :=
⟨⟨shrink α ⊕ shrink β,
  ⟨equiv.sum_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩

instance small_set {α} [small.{w} α] : small.{w} (set α) :=
⟨⟨set (shrink α), ⟨equiv.set.congr (equiv_shrink α)⟩⟩⟩

theorem not_small_type : ¬ small.{u} (Type (max u v))
| ⟨⟨S, ⟨e⟩⟩⟩ := @function.cantor_injective (Σ α, e.symm α)
  (λ a, ⟨_, cast (e.3 _).symm a⟩)
  (λ a b e, (cast_inj _).1 $ eq_of_heq (sigma.mk.inj e).2)

end


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

import data.multiset.sort
import data.pnat.interval
import data.rat.order

import tactic.norm_num
import tactic.field_simp
import tactic.interval_cases

/-!
# The inequality `p⁻¹ + q⁻¹ + r⁻¹ > 1`

In this file we classify solutions to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`, for positive natural numbers `p`, `q`, and `r`.

The solutions are exactly of the form.
* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`

This inequality shows up in Lie theory,
in the classification of Dynkin diagrams, root systems, and semisimple Lie algebras.

## Main declarations

* `pqr.A' q r`, the multiset `{1,q,r}`
* `pqr.D' r`, the multiset `{2,2,r}`
* `pqr.E6`, the multiset `{2,3,3}`
* `pqr.E7`, the multiset `{2,3,4}`
* `pqr.E8`, the multiset `{2,3,5}`
* `pqr.classification`, the classification of solutions to `p⁻¹ + q⁻¹ + r⁻¹ > 1`

-/

namespace ADE_inequality

open multiset

/-- `A' q r := {1,q,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`. -/
def A' (q r : ℕ+) : multiset ℕ+ := {1,q,r}

/-- `A r := {1,1,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $A_r$. -/
def A  (r   : ℕ+) : multiset ℕ+ := A' 1 r

/-- `D' r := {2,2,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $D_{r+2}$. -/
def D' (r   : ℕ+) : multiset ℕ+ := {2,2,r}

/-- `E' r := {2,3,r}` is a `multiset ℕ+`.
For `r ∈ {3,4,5}` is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $E_{r+3}$. -/
def E' (r   : ℕ+) : multiset ℕ+ := {2,3,r}

/-- `E6 := {2,3,3}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_6$. -/
def E6            : multiset ℕ+ := E' 3

/-- `E7 := {2,3,4}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_7$. -/
def E7            : multiset ℕ+ := E' 4

/-- `E8 := {2,3,5}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_8$. -/
def E8            : multiset ℕ+ := E' 5

/-- `sum_inv pqr` for a `pqr : multiset ℕ+` is the sum of the inverses
of the elements of `pqr`, as rational number.

The intended argument is a multiset `{p,q,r}` of cardinality `3`. -/
def sum_inv (pqr : multiset ℕ+) : ℚ :=
multiset.sum $ pqr.map $ λ x, x⁻¹

lemma sum_inv_pqr (p q r : ℕ+) : sum_inv {p,q,r} = p⁻¹ + q⁻¹ + r⁻¹ :=
by simp only [sum_inv, coe_coe, add_zero, insert_eq_cons, add_assoc,
    map_cons, sum_cons, map_singleton, sum_singleton]

/-- A multiset `pqr` of positive natural numbers is `admissible`
if it is equal to `A' q r`, or `D' r`, or one of `E6`, `E7`, or `E8`. -/
def admissible (pqr : multiset ℕ+) : Prop :=
  (∃ q r, A' q r = pqr) ∨ (∃ r, D' r = pqr) ∨ (E' 3 = pqr ∨ E' 4 = pqr ∨ E' 5 = pqr)

lemma admissible_A' (q r : ℕ+) : admissible (A' q r) := or.inl ⟨q, r, rfl⟩
lemma admissible_D' (n : ℕ+) : admissible (D' n) := or.inr $ or.inl ⟨n, rfl⟩

lemma admissible_E'3 : admissible (E' 3) := or.inr $ or.inr $ or.inl rfl
lemma admissible_E'4 : admissible (E' 4) := or.inr $ or.inr $ or.inr $ or.inl rfl
lemma admissible_E'5 : admissible (E' 5) := or.inr $ or.inr $ or.inr $ or.inr rfl

lemma admissible.one_lt_sum_inv {pqr : multiset ℕ+} :
  admissible pqr → 1 < sum_inv pqr :=
begin
  rw [admissible],
  rintro (⟨p', q', H⟩|⟨n, H⟩|H|H|H),
  { rw [← H, A', sum_inv_pqr, add_assoc],
    simp only [lt_add_iff_pos_right, pnat.one_coe, inv_one, nat.cast_one, coe_coe],
    apply add_pos; simp only [pnat.pos, nat.cast_pos, inv_pos] },
  { rw [← H, D', sum_inv_pqr],
    simp only [lt_add_iff_pos_right, pnat.one_coe, inv_one, nat.cast_one,
      coe_coe, pnat.coe_bit0, nat.cast_bit0],
    norm_num },
  all_goals { rw [← H, E', sum_inv_pqr], norm_num }
end

lemma lt_three {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r) (H : 1 < sum_inv {p, q, r}) :
  p < 3 :=
begin
  have h3 : (0:ℚ) < 3, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  have h3q := H.trans hpq,
  have h3r := h3q.trans hqr,
  calc (p⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 3⁻¹ + 3⁻¹ + 3⁻¹ : add_le_add (add_le_add _ _) _
  ... = 1 : by norm_num,
  all_goals { rw inv_le_inv _ h3; [assumption_mod_cast, norm_num] }
end

lemma lt_four {q r : ℕ+} (hqr : q ≤ r) (H : 1 < sum_inv {2, q, r}) :
  q < 4 :=
begin
  have h4 : (0:ℚ) < 4, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  have h4r := H.trans hqr,
  simp only [pnat.coe_bit0, nat.cast_bit0, pnat.one_coe, nat.cast_one, coe_coe],
  calc (2⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 4⁻¹ + 4⁻¹ : add_le_add (add_le_add le_rfl _) _
  ... = 1 : by norm_num,
  all_goals { rw inv_le_inv _ h4; [assumption_mod_cast, norm_num] }
end

lemma lt_six {r : ℕ+} (H : 1 < sum_inv {2, 3, r}) :
  r < 6 :=
begin
  have h6 : (0:ℚ) < 6, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  simp only [pnat.coe_bit0, nat.cast_bit0, pnat.one_coe, nat.cast_bit1, nat.cast_one,
    pnat.coe_bit1, coe_coe],
  calc (2⁻¹ + 3⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 3⁻¹ + 6⁻¹ : add_le_add (add_le_add le_rfl le_rfl) _
  ... = 1 : by norm_num,
  rw inv_le_inv _ h6; [assumption_mod_cast, norm_num]
end

lemma admissible_of_one_lt_sum_inv_aux' {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r)
  (H : 1 < sum_inv {p,q,r}) :
  admissible {p,q,r} :=
begin
  have hp3 : p < 3 := lt_three hpq hqr H,
  interval_cases p,
  { exact admissible_A' q r },
  have hq4 : q < 4 := lt_four hqr H,
  interval_cases q,
  { exact admissible_D' r },
  have hr6 : r < 6 := lt_six H,
  interval_cases r,
  { exact admissible_E6 },
  { exact admissible_E7 },
  { exact admissible_E8 }
end

lemma admissible_of_one_lt_sum_inv_aux :
  ∀ {pqr : list ℕ+} (hs : pqr.sorted (≤)) (hl : pqr.length = 3) (H : 1 < sum_inv pqr),
    admissible pqr
| [p,q,r] hs hl H :=
begin
  obtain ⟨⟨hpq, -⟩, hqr⟩ : (p ≤ q ∧ p ≤ r) ∧ q ≤ r,
  simpa using hs,
  exact admissible_of_one_lt_sum_inv_aux' hpq hqr H,
end

lemma admissible_of_one_lt_sum_inv {p q r : ℕ+} (H : 1 < sum_inv {p,q,r}) :
  admissible {p,q,r} :=
begin
  simp only [admissible],
  let S := sort ((≤) : ℕ+ → ℕ+ → Prop) {p,q,r},
  have hS : S.sorted (≤) := sort_sorted _ _,
  have hpqr : ({p,q,r} : multiset ℕ+) = S := (sort_eq has_le.le {p, q, r}).symm,
  simp only [hpqr] at *,
  apply admissible_of_one_lt_sum_inv_aux hS _ H,
  simp only [S, length_sort],
  dec_trivial,
end

/-- A multiset `{p,q,r}` of positive natural numbers
is a solution to `(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1` if and only if
it is `admissible` which means it is one of:

* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`
-/
lemma classification (p q r : ℕ+) :
  1 < sum_inv {p,q,r} ↔ admissible {p,q,r} :=
⟨admissible_of_one_lt_sum_inv, admissible.one_lt_sum_inv⟩

end ADE_inequality