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

! This file was ported from Lean 3 source module category_theory.limits.cone_category
! leanprover-community/mathlib commit 18302a460eb6a071cf0bfe11a4df025c8f8af244
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Adjunction.Comma
import Mathlib.CategoryTheory.Limits.Preserves.Shapes.Terminal
import Mathlib.CategoryTheory.StructuredArrow
import Mathlib.CategoryTheory.Limits.Shapes.Equivalence

/-!
# Limits and the category of (co)cones

This files contains results that stem from the limit API. For the definition and the category
instance of `Cone`, please refer to `CategoryTheory/Limits/Cones.lean`.

## Main results
* The category of cones on `F : J ⥤ C` is equivalent to the category
  `CostructuredArrow (const J) F`.
* A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of
  categories of cones preserves limiting properties.

-/

namespace CategoryTheory.Limits

open CategoryTheory CategoryTheory.Functor

universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variable {J : Type u₁} [Category.{v₁} J] {K : Type u₂} [Category.{v₂} K]

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

/-- Construct an object of the category `(Δ ↓ F)` from a cone on `F`. This is part of an
    equivalence, see `Cone.equivCostructuredArrow`. -/
@[simps]
def Cone.toCostructuredArrow (F : J ⥤ C) : Cone F ⥤ CostructuredArrow (const J) F
    where
  obj c := CostructuredArrow.mk c.π
  map f :=
    CostructuredArrow.homMk f.Hom <| by
      ext
      simp
#align category_theory.limits.cone.to_costructured_arrow CategoryTheory.Limits.Cone.toCostructuredArrow

/-- Construct a cone on `F` from an object of the category `(Δ ↓ F)`. This is part of an
    equivalence, see `Cone.equivCostructuredArrow`. -/
@[simps]
def Cone.fromCostructuredArrow (F : J ⥤ C) : CostructuredArrow (const J) F ⥤ Cone F
    where
  obj c := ⟨c.left, c.hom⟩
  map f :=
    { Hom := f.left
      w := fun j => by
        convert congr_fun (congr_arg NatTrans.app f.w) j
        dsimp
        simp }
#align category_theory.limits.cone.from_costructured_arrow CategoryTheory.Limits.Cone.fromCostructuredArrow

/-
Porting note:
`simps!` alone generated lemmas of the form `_ = _` where `_` are proofs of some proposition.
This caused the simpNF linter to complain.
We therefore explicitly tell simps! to avoid applying projections for `PLift` and `ULift`.
Similarly for `Cocone.equivStructuredArrow`.
-/
/-- The category of cones on `F` is just the comma category `(Δ ↓ F)`, where `Δ` is the constant
    functor. -/
@[simps! (config := { notRecursive := [`PLift, `ULift] })]
def Cone.equivCostructuredArrow (F : J ⥤ C) : Cone F ≌ CostructuredArrow (const J) F :=
  Equivalence.mk (Cone.toCostructuredArrow F) (Cone.fromCostructuredArrow F)
    (NatIso.ofComponents Cones.eta (by aesop_cat))
    (NatIso.ofComponents (fun c => (CostructuredArrow.eta _).symm)
      (by intros ; apply CostructuredArrow.ext ; aesop_cat))
#align category_theory.limits.cone.equiv_costructured_arrow CategoryTheory.Limits.Cone.equivCostructuredArrow

/-- A cone is a limit cone iff it is terminal. -/
def Cone.isLimitEquivIsTerminal {F : J ⥤ C} (c : Cone F) : IsLimit c ≃ IsTerminal c :=
  IsLimit.isoUniqueConeMorphism.toEquiv.trans
    { toFun := fun h => IsTerminal.ofUnique _
      invFun := fun h s => ⟨⟨IsTerminal.from h s⟩, fun a => IsTerminal.hom_ext h a _⟩
      left_inv := by aesop_cat
      right_inv := by aesop_cat }
#align category_theory.limits.cone.is_limit_equiv_is_terminal CategoryTheory.Limits.Cone.isLimitEquivIsTerminal

theorem hasLimit_iff_hasTerminal_cone (F : J ⥤ C) : HasLimit F ↔ HasTerminal (Cone F) :=
  ⟨fun _ => (Cone.isLimitEquivIsTerminal _ (limit.isLimit F)).hasTerminal, fun h =>
    haveI : HasTerminal (Cone F) := h
    ⟨⟨⟨⊤_ _, (Cone.isLimitEquivIsTerminal _).symm terminalIsTerminal⟩⟩⟩⟩
#align category_theory.limits.has_limit_iff_has_terminal_cone CategoryTheory.Limits.hasLimit_iff_hasTerminal_cone

theorem hasLimitsOfShape_iff_isLeftAdjoint_const :
    HasLimitsOfShape J C ↔ Nonempty (IsLeftAdjoint (const J : C ⥤ _)) :=
  calc
    HasLimitsOfShape J C ↔ ∀ F : J ⥤ C, HasLimit F :=
      ⟨fun h => h.has_limit, fun h => HasLimitsOfShape.mk⟩
    _ ↔ ∀ F : J ⥤ C, HasTerminal (Cone F) := (forall_congr' hasLimit_iff_hasTerminal_cone)
    _ ↔ ∀ F : J ⥤ C, HasTerminal (CostructuredArrow (const J) F) :=
      (forall_congr' fun F => (Cone.equivCostructuredArrow F).hasTerminal_iff)
    _ ↔ Nonempty (IsLeftAdjoint (const J : C ⥤ _)) :=
      nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow.symm

#align category_theory.limits.has_limits_of_shape_iff_is_left_adjoint_const CategoryTheory.Limits.hasLimitsOfShape_iff_isLeftAdjoint_const

theorem IsLimit.liftConeMorphism_eq_isTerminal_from {F : J ⥤ C} {c : Cone F} (hc : IsLimit c)
    (s : Cone F) : hc.liftConeMorphism s = IsTerminal.from (Cone.isLimitEquivIsTerminal _ hc) _ :=
  rfl
#align category_theory.limits.is_limit.lift_cone_morphism_eq_is_terminal_from CategoryTheory.Limits.IsLimit.liftConeMorphism_eq_isTerminal_from

theorem IsTerminal.from_eq_liftConeMorphism {F : J ⥤ C} {c : Cone F} (hc : IsTerminal c)
    (s : Cone F) :
    IsTerminal.from hc s = ((Cone.isLimitEquivIsTerminal _).symm hc).liftConeMorphism s :=
  (IsLimit.liftConeMorphism_eq_isTerminal_from (c.isLimitEquivIsTerminal.symm hc) s).symm
#align category_theory.limits.is_terminal.from_eq_lift_cone_morphism CategoryTheory.Limits.IsTerminal.from_eq_liftConeMorphism

/-- If `G : Cone F ⥤ Cone F'` preserves terminal objects, it preserves limit cones. -/
def IsLimit.ofPreservesConeTerminal {F : J ⥤ C} {F' : K ⥤ D} (G : Cone F ⥤ Cone F')
    [PreservesLimit (Functor.empty.{0} _) G] {c : Cone F} (hc : IsLimit c) : IsLimit (G.obj c) :=
  (Cone.isLimitEquivIsTerminal _).symm <| (Cone.isLimitEquivIsTerminal _ hc).isTerminalObj _ _
#align category_theory.limits.is_limit.of_preserves_cone_terminal CategoryTheory.Limits.IsLimit.ofPreservesConeTerminal

/-- If `G : Cone F ⥤ Cone F'` reflects terminal objects, it reflects limit cones. -/
def IsLimit.ofReflectsConeTerminal {F : J ⥤ C} {F' : K ⥤ D} (G : Cone F ⥤ Cone F')
    [ReflectsLimit (Functor.empty.{0} _) G] {c : Cone F} (hc : IsLimit (G.obj c)) : IsLimit c :=
  (Cone.isLimitEquivIsTerminal _).symm <| (Cone.isLimitEquivIsTerminal _ hc).isTerminalOfObj _ _
#align category_theory.limits.is_limit.of_reflects_cone_terminal CategoryTheory.Limits.IsLimit.ofReflectsConeTerminal

/-- Construct an object of the category `(F ↓ Δ)` from a cocone on `F`. This is part of an
    equivalence, see `Cocone.equivStructuredArrow`. -/
@[simps]
def Cocone.toStructuredArrow (F : J ⥤ C) : Cocone F ⥤ StructuredArrow F (const J)
    where
  obj c := StructuredArrow.mk c.ι
  map f :=
    StructuredArrow.homMk f.Hom <| by
      ext
      simp
#align category_theory.limits.cocone.to_structured_arrow CategoryTheory.Limits.Cocone.toStructuredArrow

/-- Construct a cocone on `F` from an object of the category `(F ↓ Δ)`. This is part of an
    equivalence, see `Cocone.equivStructuredArrow`. -/
@[simps]
def Cocone.fromStructuredArrow (F : J ⥤ C) : StructuredArrow F (const J) ⥤ Cocone F
    where
  obj c := ⟨c.right, c.hom⟩
  map f :=
    { Hom := f.right
      w := fun j => by
        convert (congr_fun (congr_arg NatTrans.app f.w) j).symm
        dsimp
        simp }
#align category_theory.limits.cocone.from_structured_arrow
  CategoryTheory.Limits.Cocone.fromStructuredArrow

/-- The category of cocones on `F` is just the comma category `(F ↓ Δ)`, where `Δ` is the constant
    functor. -/
@[simps! (config := { notRecursive := [`PLift, `ULift] })]
def Cocone.equivStructuredArrow (F : J ⥤ C) : Cocone F ≌ StructuredArrow F (const J) :=
  Equivalence.mk (Cocone.toStructuredArrow F) (Cocone.fromStructuredArrow F)
    (NatIso.ofComponents Cocones.eta (by aesop_cat))
    (NatIso.ofComponents (fun c => (StructuredArrow.eta _).symm)
      (by intros ; apply StructuredArrow.ext ; aesop_cat))
#align category_theory.limits.cocone.equiv_structured_arrow CategoryTheory.Limits.Cocone.equivStructuredArrow

/-- A cocone is a colimit cocone iff it is initial. -/
def Cocone.isColimitEquivIsInitial {F : J ⥤ C} (c : Cocone F) : IsColimit c ≃ IsInitial c :=
  IsColimit.isoUniqueCoconeMorphism.toEquiv.trans
    { toFun := fun h => IsInitial.ofUnique _
      invFun := fun h s => ⟨⟨IsInitial.to h s⟩, fun a => IsInitial.hom_ext h a _⟩
      left_inv := by aesop_cat
      right_inv := by aesop_cat }
#align category_theory.limits.cocone.is_colimit_equiv_is_initial CategoryTheory.Limits.Cocone.isColimitEquivIsInitial

theorem hasColimit_iff_hasInitial_cocone (F : J ⥤ C) : HasColimit F ↔ HasInitial (Cocone F) :=
  ⟨fun _ => (Cocone.isColimitEquivIsInitial _ (colimit.isColimit F)).hasInitial, fun h =>
    haveI : HasInitial (Cocone F) := h
    ⟨⟨⟨⊥_ _, (Cocone.isColimitEquivIsInitial _).symm initialIsInitial⟩⟩⟩⟩
#align category_theory.limits.has_colimit_iff_has_initial_cocone
  CategoryTheory.Limits.hasColimit_iff_hasInitial_cocone

theorem hasColimitsOfShape_iff_isRightAdjoint_const :
    HasColimitsOfShape J C ↔ Nonempty (IsRightAdjoint (const J : C ⥤ _)) :=
  calc
    HasColimitsOfShape J C ↔ ∀ F : J ⥤ C, HasColimit F :=
      ⟨fun h => h.has_colimit, fun h => HasColimitsOfShape.mk⟩
    _ ↔ ∀ F : J ⥤ C, HasInitial (Cocone F) := (forall_congr' hasColimit_iff_hasInitial_cocone)
    _ ↔ ∀ F : J ⥤ C, HasInitial (StructuredArrow F (const J)) :=
      (forall_congr' fun F => (Cocone.equivStructuredArrow F).hasInitial_iff)
    _ ↔ Nonempty (IsRightAdjoint (const J : C ⥤ _)) :=
      nonempty_isRightAdjoint_iff_hasInitial_structuredArrow.symm

#align category_theory.limits.has_colimits_of_shape_iff_is_right_adjoint_const
  CategoryTheory.Limits.hasColimitsOfShape_iff_isRightAdjoint_const

theorem IsInitial.to_eq_descCoconeMorphism {F : J ⥤ C} {c : Cocone F} (hc : IsInitial c)
    (s : Cocone F) :
    IsInitial.to hc s = ((Cocone.isColimitEquivIsInitial _).symm hc).descCoconeMorphism s :=
  (IsColimit.descCoconeMorphism_eq_isInitial_to (c.isColimitEquivIsInitial.symm hc) s).symm
#align category_theory.limits.is_initial.to_eq_desc_cocone_morphism CategoryTheory.Limits.IsInitial.to_eq_descCoconeMorphism

/-- If `G : Cocone F ⥤ Cocone F'` preserves initial objects, it preserves colimit cocones. -/
def IsColimit.ofPreservesCoconeInitial {F : J ⥤ C} {F' : K ⥤ D} (G : Cocone F ⥤ Cocone F')
    [PreservesColimit (Functor.empty.{0} _) G] {c : Cocone F} (hc : IsColimit c) :
    IsColimit (G.obj c) :=
  (Cocone.isColimitEquivIsInitial _).symm <| (Cocone.isColimitEquivIsInitial _ hc).isInitialObj _ _
#align category_theory.limits.is_colimit.of_preserves_cocone_initial CategoryTheory.Limits.IsColimit.ofPreservesCoconeInitial

/-- If `G : Cocone F ⥤ Cocone F'` reflects initial objects, it reflects colimit cocones. -/
def IsColimit.ofReflectsCoconeInitial {F : J ⥤ C} {F' : K ⥤ D} (G : Cocone F ⥤ Cocone F')
    [ReflectsColimit (Functor.empty.{0} _) G] {c : Cocone F} (hc : IsColimit (G.obj c)) :
    IsColimit c :=
  (Cocone.isColimitEquivIsInitial _).symm <|
    (Cocone.isColimitEquivIsInitial _ hc).isInitialOfObj _ _
#align category_theory.limits.is_colimit.of_reflects_cocone_initial CategoryTheory.Limits.IsColimit.ofReflectsCoconeInitial

end CategoryTheory.Limits


import .simplify_le

namespace nat

theorem step_induction_on {C : ℕ → Prop} {c:ℕ} (c_pos:0 < c)
(base : ∀(m:ℕ), m < c → C m)
(step : ∀(m:ℕ), C m → C (m + c))
: ∀ (n:ℕ), C n :=
begin
  intro n,
  induction n using nat.strong_induction_on with n ind,
  by_cases (n < c),
  {
    exact base n h,
  },
  {
    have n_ge_c : n ≥ c := le_of_not_gt h,
    have n_pos : n > 0 := lt_of_lt_of_le c_pos n_ge_c,
    have cong : (n-c)+c = n := nat.sub_add_cancel n_ge_c,
    have lt : n-c < n := nat.sub_lt n_pos c_pos,
    rw [cong.symm],
    apply step,
    exact ind (n-c) lt,
  }
end

theorem mul_eq_add_mod (x y n : ℕ) : (x * n + y) % n = y % n :=
begin
  induction x,
  all_goals { simp, }
end

theorem mod_add_right_mod (x y n : ℕ) : (x + (y % n)) % n = (x + y) % n :=
begin
  by_cases 0 < n with h,
  {
    induction y using nat.step_induction_on with y y_lt_n y ind,
    exact n,
    exact h,
    -- base case
    { simp [mod_eq_of_lt, *],},
    -- inductive case
    { -- Simplify left-hand side
      simp only [mod_eq_sub_mod, add_sub_cancel, ge, le_add_left,
                 nat.add_sub_cancel, ind],
      -- Simplify right-hand side
      simp only [eq.symm (nat.add_assoc x y n),
                mod_eq_sub_mod (nat.le_add_left n (x+y))],
      simp only [nat.add_sub_cancel],
    },
  },
  {
    have n_eq_zero := eq_zero_or_pos n,
    simp [gt, h] at n_eq_zero,
    simp [n_eq_zero],
  }
end

theorem mod_mul_right_mod (x y n : ℕ) : x * (y % n) % n = (x * y) % n :=
begin
  by_cases 0 < n with h,
  {
    induction y using nat.step_induction_on with y y_lt_n y ind,
    exact n,
    exact h,
    { simp [mod_eq_of_lt, *],},
    { simp [mul_add, mul_eq_add_mod, ind], }
  },
  { have e := eq_zero_or_pos n,
    -- Simplify e to n = 0
    simp only [gt,h,or_false] at e,
    -- Replace n with 0 and simplify
    simp only [e,mod_zero],
  }
end

theorem mod_mul_left_mod (x y n : ℕ) : ((x % n) * y) % n = (x * y) % n :=
begin
  rw [nat.mul_comm],
  transitivity,
  apply mod_mul_right_mod,
  rw [nat.mul_comm],
end

-- Dividing a positive number by a number greater than one results in a
-- a smaller number.
protected lemma div_lt_self : ∀{m n : ℕ}, 0 < m → 1 < n → m / n < m :=
begin
  intros m0,
  apply nat.strong_induction_on m0 _,
  intros m rec n zero_lt_m n_gt_1,
  rw [nat.div_def_aux],
  have n_gt_0 : n > 0 := lt_of_succ_lt n_gt_1,
  by_cases n ≤ m with n_le_m,
  { have m_gt_1 : 1 < m := nat.lt_of_lt_of_le n_gt_1 n_le_m,
    rw dif_pos (and.intro n_gt_0 n_le_m),
    by_cases n = m with n_eq_m,
    { simp [n_eq_m] at n_gt_1,
      simp [n_eq_m, nat.sub_self],
      exact n_gt_1,
    },

    { rename n_eq_m n_ne_m, transitivity,
      { apply nat.add_lt_add_right,
        { apply rec,
          { exact sub_lt zero_lt_m n_gt_0, },
          { have n_lt_m : n < m := nat.lt_of_le_and_ne n_le_m n_ne_m,
            simp [gt, nat.lt_sub_iff, n_lt_m],
          },
          { exact n_gt_1, },
        },
      },
      { simp [nat.sub_add_iff, n_le_m, nat.sub_lt_iff', zero_lt_m],
        apply add_lt_add_left,
        exact n_gt_1,
      },
    },
  },
  { rename n_le_m n_gt_m,
    rw [dif_neg],
    { exact zero_lt_m, },
    { simp [n_gt_m], },
  }
end

end nat


import tactic

-- Let X be the set {A,B,C}
inductive X
| A : X
| B : X
| C : X

open X

def R (x y : X) : Prop := (x = A ∧ y = B) ∨ (x = A ∧ y = C)
-- R(A,B) and R(A,C) both true, everything else false

theorem R_fst {x y : X} : R x y → x = A :=
begin
  intro h,
  cases h,
    cases h,
    assumption,
  cases h,
  assumption,
end

example : transitive R :=
begin
  intros x y z,
  intro hxy,
  intro hyz,
  have h1 := R_fst hxy,
  have h2 := R_fst hyz,
  subst h1,
  subst h2,
  assumption,
end

example (P Q : Prop) : (P → Q) → (¬ Q → ¬ P) :=
begin
  intro hPQ,
  intro hnQ,
  intro hP,
  apply hnQ,
  exact hPQ hP,
end


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Mario Carneiro
-/
import analysis.special_functions.trigonometric.bounds

/-!
# Pi

This file contains lemmas which establish bounds on `real.pi`.
Notably, these include `pi_gt_sqrt_two_add_series` and `pi_lt_sqrt_two_add_series`,
which bound `π` using series;
numerical bounds on `π` such as `pi_gt_314`and `pi_lt_315` (more precise versions are given, too).

See also `data.real.pi.leibniz` and `data.real.pi.wallis` for infinite formulas for `π`.
-/

open_locale real
namespace real

lemma pi_gt_sqrt_two_add_series (n : ℕ) : 2 ^ (n+1) * sqrt (2 - sqrt_two_add_series 0 n) < π :=
begin
  have : sqrt (2 - sqrt_two_add_series 0 n) / 2 * 2 ^ (n+2) < π,
  { rw [← lt_div_iff, ←sin_pi_over_two_pow_succ], apply sin_lt, apply div_pos pi_pos,
    all_goals { apply pow_pos, norm_num } },
  apply lt_of_le_of_lt (le_of_eq _) this,
  rw [pow_succ _ (n+1), ←mul_assoc, div_mul_cancel, mul_comm], norm_num
end

lemma pi_lt_sqrt_two_add_series (n : ℕ) :
  π < 2 ^ (n+1) * sqrt (2 - sqrt_two_add_series 0 n) + 1 / 4 ^ n :=
begin
  have : π < (sqrt (2 - sqrt_two_add_series 0 n) / 2 + 1 / (2 ^ n) ^ 3 / 4) * 2 ^ (n+2),
  { rw [← div_lt_iff, ← sin_pi_over_two_pow_succ],
    refine lt_of_lt_of_le (lt_add_of_sub_right_lt (sin_gt_sub_cube _ _)) _,
    { apply div_pos pi_pos, apply pow_pos, norm_num },
    { rw div_le_iff',
      { refine le_trans pi_le_four _,
        simp only [show ((4 : ℝ) = 2 ^ 2), by norm_num, mul_one],
        apply pow_le_pow, norm_num, apply le_add_of_nonneg_left, apply nat.zero_le },
      { apply pow_pos, norm_num } },
    apply add_le_add_left, rw div_le_div_right,
    rw [le_div_iff, ←mul_pow],
    refine le_trans _ (le_of_eq (one_pow 3)), apply pow_le_pow_of_le_left,
    { apply le_of_lt, apply mul_pos, apply div_pos pi_pos, apply pow_pos, norm_num, apply pow_pos,
      norm_num },
    rw ← le_div_iff,
    refine le_trans ((div_le_div_right _).mpr pi_le_four) _, apply pow_pos, norm_num,
    rw [pow_succ, pow_succ, ←mul_assoc, ←div_div],
    convert le_rfl,
    all_goals { repeat {apply pow_pos}, norm_num }},
  apply lt_of_lt_of_le this (le_of_eq _), rw [add_mul], congr' 1,
  { rw [pow_succ _ (n+1), ←mul_assoc, div_mul_cancel, mul_comm], norm_num },
  rw [pow_succ, ←pow_mul, mul_comm n 2, pow_mul, show (2 : ℝ) ^ 2 = 4, by norm_num, pow_succ,
      pow_succ, ←mul_assoc (2 : ℝ), show (2 : ℝ) * 2 = 4, by norm_num, ←mul_assoc, div_mul_cancel,
      mul_comm ((2 : ℝ) ^ n), ←div_div, div_mul_cancel],
  apply pow_ne_zero, norm_num, norm_num
end

/-- From an upper bound on `sqrt_two_add_series 0 n = 2 cos (π / 2 ^ (n+1))` of the form
`sqrt_two_add_series 0 n ≤ 2 - (a / 2 ^ (n + 1)) ^ 2)`, one can deduce the lower bound `a < π`
thanks to basic trigonometric inequalities as expressed in `pi_gt_sqrt_two_add_series`. -/
theorem pi_lower_bound_start (n : ℕ) {a}
  (h : sqrt_two_add_series ((0:ℕ) / (1:ℕ)) n ≤ 2 - (a / 2 ^ (n + 1)) ^ 2) : a < π :=
begin
  refine lt_of_le_of_lt _ (pi_gt_sqrt_two_add_series n), rw [mul_comm],
  refine (div_le_iff (pow_pos (by norm_num) _ : (0 : ℝ) < _)).mp (le_sqrt_of_sq_le _),
  rwa [le_sub_comm, show (0:ℝ) = (0:ℕ)/(1:ℕ), by rw [nat.cast_zero, zero_div]],
end

lemma sqrt_two_add_series_step_up (c d : ℕ) {a b n : ℕ} {z : ℝ}
  (hz : sqrt_two_add_series (c/d) n ≤ z) (hb : 0 < b) (hd : 0 < d)
  (h : (2 * b + a) * d ^ 2 ≤ c ^ 2 * b) : sqrt_two_add_series (a/b) (n+1) ≤ z :=
begin
  refine le_trans _ hz, rw sqrt_two_add_series_succ, apply sqrt_two_add_series_monotone_left,
  have hb' : 0 < (b:ℝ) := nat.cast_pos.2 hb,
  have hd' : 0 < (d:ℝ) := nat.cast_pos.2 hd,
  rw [sqrt_le_left (div_nonneg c.cast_nonneg d.cast_nonneg), div_pow,
    add_div_eq_mul_add_div _ _ (ne_of_gt hb'), div_le_div_iff hb' (pow_pos hd' _)],
  exact_mod_cast h
end

/-- Create a proof of `a < π` for a fixed rational number `a`, given a witness, which is a
sequence of rational numbers `sqrt 2 < r 1 < r 2 < ... < r n < 2` satisfying the property that
`sqrt (2 + r i) ≤ r(i+1)`, where `r 0 = 0` and `sqrt (2 - r n) ≥ a/2^(n+1)`. -/
meta def pi_lower_bound (l : list ℚ) : tactic unit :=
do let n := l.length,
  tactic.apply `(@pi_lower_bound_start %%(reflect n)),
  l.mmap' (λ r, do
    let a := r.num.to_nat, let b := r.denom,
    (() <$ tactic.apply `(@sqrt_two_add_series_step_up %%(reflect a) %%(reflect b)));
    [tactic.skip, `[norm_num1], `[norm_num1], `[norm_num1]]),
  `[simp only [sqrt_two_add_series, nat.cast_bit0, nat.cast_bit1, nat.cast_one, nat.cast_zero]],
  `[norm_num1]

/-- From a lower bound on `sqrt_two_add_series 0 n = 2 cos (π / 2 ^ (n+1))` of the form
`2 - ((a - 1 / 4 ^ n) / 2 ^ (n + 1)) ^ 2 ≤ sqrt_two_add_series 0 n`, one can deduce the upper bound
`π < a` thanks to basic trigonometric formulas as expressed in `pi_lt_sqrt_two_add_series`. -/
theorem pi_upper_bound_start (n : ℕ) {a}
  (h : 2 - ((a - 1 / 4 ^ n) / 2 ^ (n + 1)) ^ 2 ≤ sqrt_two_add_series ((0:ℕ) / (1:ℕ)) n)
  (h₂ : 1 / 4 ^ n ≤ a) : π < a :=
begin
  refine lt_of_lt_of_le (pi_lt_sqrt_two_add_series n) _,
  rw [← le_sub_iff_add_le, ← le_div_iff', sqrt_le_left, sub_le_comm],
  { rwa [nat.cast_zero, zero_div] at h },
  { exact div_nonneg (sub_nonneg.2 h₂) (pow_nonneg (le_of_lt zero_lt_two) _) },
  { exact pow_pos zero_lt_two _ }
end

lemma sqrt_two_add_series_step_down (a b : ℕ) {c d n : ℕ} {z : ℝ}
  (hz : z ≤ sqrt_two_add_series (a/b) n) (hb : 0 < b) (hd : 0 < d)
  (h : a ^ 2 * d ≤ (2 * d + c) * b ^ 2) : z ≤ sqrt_two_add_series (c/d) (n+1) :=
begin
  apply le_trans hz, rw sqrt_two_add_series_succ, apply sqrt_two_add_series_monotone_left,
  apply le_sqrt_of_sq_le,
  have hb' : 0 < (b:ℝ) := nat.cast_pos.2 hb,
  have hd' : 0 < (d:ℝ) := nat.cast_pos.2 hd,
  rw [div_pow, add_div_eq_mul_add_div _ _ (ne_of_gt hd'), div_le_div_iff (pow_pos hb' _) hd'],
  exact_mod_cast h
end

/-- Create a proof of `π < a` for a fixed rational number `a`, given a witness, which is a
sequence of rational numbers `sqrt 2 < r 1 < r 2 < ... < r n < 2` satisfying the property that
`sqrt (2 + r i) ≥ r(i+1)`, where `r 0 = 0` and `sqrt (2 - r n) ≥ (a - 1/4^n) / 2^(n+1)`. -/
meta def pi_upper_bound (l : list ℚ) : tactic unit :=
do let n := l.length,
  (() <$ tactic.apply `(@pi_upper_bound_start %%(reflect n))); [pure (), `[norm_num1]],
  l.mmap' (λ r, do
    let a := r.num.to_nat, let b := r.denom,
    (() <$ tactic.apply `(@sqrt_two_add_series_step_down %%(reflect a) %%(reflect b)));
    [pure (), `[norm_num1], `[norm_num1], `[norm_num1]]),
  `[simp only [sqrt_two_add_series, nat.cast_bit0, nat.cast_bit1, nat.cast_one, nat.cast_zero]],
  `[norm_num]

lemma pi_gt_three : 3 < π := by pi_lower_bound [23/16]

lemma pi_gt_314 : 3.14 < π := by pi_lower_bound [99/70, 874/473, 1940/989, 1447/727]

lemma pi_lt_315 : π < 3.15 := by pi_upper_bound [140/99, 279/151, 51/26, 412/207]

lemma pi_gt_31415 : 3.1415 < π := by pi_lower_bound [
  11482/8119, 5401/2923, 2348/1197, 11367/5711, 25705/12868, 23235/11621]

lemma pi_gt_3141592 : 3.141592 < π := by pi_lower_bound [
  11482/8119, 7792/4217, 54055/27557, 949247/476920, 3310126/1657059,
  2635492/1318143, 1580265/790192, 1221775/610899, 3612247/1806132, 849943/424972]

lemma pi_lt_3141593 : π < 3.141593 := by pi_upper_bound [
  27720/19601, 56935/30813, 49359/25163, 258754/130003, 113599/56868, 1101994/551163,
  8671537/4336095, 3877807/1938940, 52483813/26242030, 56946167/28473117, 23798415/11899211]

end real


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.int.dvd.basic
import data.nat.order.lemmas
import algebra.ring.regular

/-!
# Lemmas relating `/` in `ℤ` with the ordering.

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

open nat

namespace int

theorem eq_mul_div_of_mul_eq_mul_of_dvd_left {a b c d : ℤ} (hb : b ≠ 0) (hbc : b ∣ c)
    (h : b * a = c * d) :
  a = c / b * d :=
begin
  cases hbc with k hk,
  subst hk,
  rw [int.mul_div_cancel_left _ hb],
  rw mul_assoc at h,
  apply mul_left_cancel₀ hb h
end

/-- If an integer with larger absolute value divides an integer, it is
zero. -/
lemma eq_zero_of_dvd_of_nat_abs_lt_nat_abs {a b : ℤ} (w : a ∣ b) (h : nat_abs b < nat_abs a) :
  b = 0 :=
begin
  rw [←nat_abs_dvd, ←dvd_nat_abs, coe_nat_dvd] at w,
  rw ←nat_abs_eq_zero,
  exact eq_zero_of_dvd_of_lt w h
end

lemma eq_zero_of_dvd_of_nonneg_of_lt {a b : ℤ} (w₁ : 0 ≤ a) (w₂ : a < b) (h : b ∣ a) : a = 0 :=
eq_zero_of_dvd_of_nat_abs_lt_nat_abs h (nat_abs_lt_nat_abs_of_nonneg_of_lt w₁ w₂)

/-- If two integers are congruent to a sufficiently large modulus,
they are equal. -/
lemma eq_of_mod_eq_of_nat_abs_sub_lt_nat_abs {a b c : ℤ} (h1 : a % b = c)
    (h2 : nat_abs (a - c) < nat_abs b) :
  a = c :=
eq_of_sub_eq_zero (eq_zero_of_dvd_of_nat_abs_lt_nat_abs (dvd_sub_of_mod_eq h1) h2)

theorem of_nat_add_neg_succ_of_nat_of_ge {m n : ℕ}
  (h : n.succ ≤ m) : of_nat m + -[1+n] = of_nat (m - n.succ) :=
begin
  change sub_nat_nat _ _ = _,
  have h' : n.succ - m = 0,
  apply tsub_eq_zero_iff_le.mpr h,
  simp [*, sub_nat_nat]
end

lemma nat_abs_le_of_dvd_ne_zero {s t : ℤ} (hst : s ∣ t) (ht : t ≠ 0) : nat_abs s ≤ nat_abs t :=
not_lt.mp (mt (eq_zero_of_dvd_of_nat_abs_lt_nat_abs hst) ht)

end int


universe u

reserve infix ` /= `:50
notation [parsing_only] a /= b := ne a b

/- irreflexive functions -/

def irreflexive_fun {A : Sort u} (f : A -> A)
  := forall a, f a /= a

class is_irrefl_fun {A : Sort u} (f : A -> A) :=
  (fun_irrefl : forall a, f a /= a)

export is_irrefl_fun (fun_irrefl)

/- types with irreflexive functions -/

class has_anot (A : Sort u) :=
  (anot : A -> A)
  (anot_ne_self : forall a, anot a /= a)

export has_anot (anot anot_ne_self)

instance anot_is_irrefl {A : Sort u} [i : has_anot A] : is_irrefl_fun anot :=
  (| i.anot_ne_self |)

/- prop not -/

theorem not_ne_self:
forall (a : Prop), not a /= a
:= begin
  intro a,
  apply ne.elim,
  assume he : not a = a,
  have hf : (not a <-> a) <-> false := not_iff_self a,
  exact hf.mp he.to_iff
end

instance not_is_irrefl : is_irrefl_fun not := (| not_ne_self |)

instance prop_has_anot : has_anot Prop := {
  anot := not,
  anot_ne_self := not_ne_self
}

/- bool not -/

theorem bnot_ne_self:
forall (a : bool), bnot a /= a
:= begin
  intro a,
  cases a,
  case bool.tt begin
    rewrite bnot,
    exact ff_eq_tt_eq_false
  end,
  case bool.ff begin
    rewrite bnot,
    exact tt_eq_ff_eq_false
  end
end

instance bnot_is_irrefl : is_irrefl_fun bnot := (| bnot_ne_self |)

instance bool_has_anot : has_anot bool := {
  anot := bnot,
  anot_ne_self := bnot_ne_self
}

/- nat not -/

namespace nat

instance succ_is_irrefl : is_irrefl_fun succ := (| succ_ne_self |)

instance has_anot_succ : has_anot nat := {
  anot := succ,
  anot_ne_self := succ_ne_self
}

end nat


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

! This file was ported from Lean 3 source module tactic.push_neg
! leanprover-community/mathlib commit da8ded3f1074e0c4fc2be04ca37d4d5ef39a8c52
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Core
import Mathbin.Logic.Basic

/-!
# A tactic pushing negations into an expression
-/

open Tactic Expr

/- Enable the option `trace.push_neg.use_distrib` in order to have `¬ (p ∧ q)` normalized to
`¬ p ∨ ¬ q`, rather than the default `p → ¬ q`. -/
initialize
  registerTraceClass.1 `push_neg.use_distrib

namespace PushNeg

section

universe u

variable {α : Sort u}

variable (p q : Prop)

variable (s : α → Prop)

attribute [local instance] Classical.propDecidable

theorem not_not_eq : (¬¬p) = p :=
  propext Classical.not_not
#align push_neg.not_not_eq PushNeg.not_not_eq

theorem not_and_eq : (¬(p ∧ q)) = (p → ¬q) :=
  propext not_and
#align push_neg.not_and_eq PushNeg.not_and_eq

theorem not_and_distrib_eq : (¬(p ∧ q)) = (¬p ∨ ¬q) :=
  propext not_and_or
#align push_neg.not_and_distrib_eq PushNeg.not_and_distrib_eq

theorem not_or_eq : (¬(p ∨ q)) = (¬p ∧ ¬q) :=
  propext not_or
#align push_neg.not_or_eq PushNeg.not_or_eq

theorem not_forall_eq : (¬∀ x, s x) = ∃ x, ¬s x :=
  propext not_forall
#align push_neg.not_forall_eq PushNeg.not_forall_eq

theorem not_exists_eq : (¬∃ x, s x) = ∀ x, ¬s x :=
  propext not_exists
#align push_neg.not_exists_eq PushNeg.not_exists_eq

theorem not_implies_eq : (¬(p → q)) = (p ∧ ¬q) :=
  propext not_imp
#align push_neg.not_implies_eq PushNeg.not_implies_eq

theorem Classical.implies_iff_not_or : p → q ↔ ¬p ∨ q :=
  imp_iff_not_or
#align push_neg.classical.implies_iff_not_or PushNeg.Classical.implies_iff_not_or

theorem not_eq (a b : α) : ¬a = b ↔ a ≠ b :=
  Iff.rfl
#align push_neg.not_eq PushNeg.not_eq

variable {β : Type u}

variable [LinearOrder β]

theorem not_le_eq (a b : β) : (¬a ≤ b) = (b < a) :=
  propext not_le
#align push_neg.not_le_eq PushNeg.not_le_eq

theorem not_lt_eq (a b : β) : (¬a < b) = (b ≤ a) :=
  propext not_lt
#align push_neg.not_lt_eq PushNeg.not_lt_eq

end

unsafe def whnf_reducible (e : expr) : tactic expr :=
  whnf e reducible
#align push_neg.whnf_reducible push_neg.whnf_reducible

-- failed to format: unknown constant 'term.pseudo.antiquot'
private unsafe
  def
    transform_negation_step
    ( e : expr ) : tactic ( Option ( expr × expr ) )
    :=
      do
        let e ← whnf_reducible e
          match
            e
            with
            |
                q( ¬ $ ( Ne ) )
                =>
                do
                  let ne ← whnf_reducible Ne
                    match
                      Ne
                      with
                      |
                          q( ¬ $ ( a ) )
                          =>
                          do let pr ← mk_app ` ` not_not_eq [ a ] return ( some ( a , pr ) )
                        |
                          q( $ ( a ) ∧ $ ( b ) )
                          =>
                          do
                            let distrib ← get_bool_option `trace.push_neg.use_distrib ff
                              if
                                Distrib
                                then
                                do
                                  let pr ← mk_app ` ` not_and_distrib_eq [ a , b ]
                                    return ( some ( q( ¬ ( $ ( a ) : Prop ) ∨ ¬ $ ( b ) ) , pr ) )
                                else
                                do
                                  let pr ← mk_app ` ` not_and_eq [ a , b ]
                                    return ( some ( q( ( $ ( a ) : Prop ) → ¬ $ ( b ) ) , pr ) )
                        |
                          q( $ ( a ) ∨ $ ( b ) )
                          =>
                          do
                            let pr ← mk_app ` ` not_or_eq [ a , b ]
                              return ( some ( q( ¬ $ ( a ) ∧ ¬ $ ( b ) ) , pr ) )
                        |
                          q( $ ( a ) ≤ $ ( b ) )
                          =>
                          do
                            let e ← to_expr ` `( $ ( b ) < $ ( a ) )
                              let pr ← mk_app ` ` not_le_eq [ a , b ]
                              return ( some ( e , pr ) )
                        |
                          q( $ ( a ) < $ ( b ) )
                          =>
                          do
                            let e ← to_expr ` `( $ ( b ) ≤ $ ( a ) )
                              let pr ← mk_app ` ` not_lt_eq [ a , b ]
                              return ( some ( e , pr ) )
                        |
                          q( Exists $ ( p ) )
                          =>
                          do
                            let pr ← mk_app ` ` not_exists_eq [ p ]
                              let
                                e
                                  ←
                                  match
                                    p
                                    with
                                    |
                                        lam n bi typ bo
                                        =>
                                        do
                                          let body ← mk_app ` ` Not [ bo ]
                                            return ( pi n bi typ body )
                                      | _ => tactic.fail "Unexpected failure negating ∃"
                              return ( some ( e , pr ) )
                        |
                          pi n bi d p
                          =>
                          if
                            p
                            then
                            do
                              let pr ← mk_app ` ` not_forall_eq [ lam n bi d p ]
                                let body ← mk_app ` ` Not [ p ]
                                let e ← mk_app ` ` Exists [ lam n bi d body ]
                                return ( some ( e , pr ) )
                            else
                            do
                              let pr ← mk_app ` ` not_implies_eq [ d , p ]
                                let q( $ ( _ ) = $ ( e' ) ) ← infer_type pr
                                return ( some ( e' , pr ) )
                        | _ => return none
              | _ => return none
#align push_neg.transform_negation_step push_neg.transform_negation_step

private unsafe def transform_negation : expr → tactic (Option (expr × expr))
  | e => do
    let some (e', pr) ← transform_negation_step e |
      return none
    let some (e'', pr') ← transform_negation e' |
      return (some (e', pr))
    let pr'' ← mk_eq_trans pr pr'
    return (some (e'', pr''))
#align push_neg.transform_negation push_neg.transform_negation

unsafe def normalize_negations (t : expr) : tactic (expr × expr) := do
  let (_, e, pr) ←
    simplify_top_down ()
        (fun _ => fun e => do
          let oepr ← transform_negation e
          match oepr with
            | some (e', pr) => return ((), e', pr)
            | none => do
              let pr ← mk_eq_refl e
              return ((), e, pr))
        t { eta := false }
  return (e, pr)
#align push_neg.normalize_negations push_neg.normalize_negations

unsafe def push_neg_at_hyp (h : Name) : tactic Unit := do
  let H ← get_local h
  let t ← infer_type H
  let (e, pr) ← normalize_negations t
  replace_hyp H e pr
  skip
#align push_neg.push_neg_at_hyp push_neg.push_neg_at_hyp

unsafe def push_neg_at_goal : tactic Unit := do
  let H ← target
  let (e, pr) ← normalize_negations H
  replace_target e pr
#align push_neg.push_neg_at_goal push_neg.push_neg_at_goal

end PushNeg

open Interactive (parse loc.ns loc.wildcard)

open Interactive.Types (location texpr)

open Lean.Parser (tk ident anyM)

open Interactive.Loc

-- mathport name: parser.optional
local postfix:1024 "?" => optional

-- mathport name: parser.many
local postfix:1024 "*" => many

open PushNeg

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Push negations in the goal of some assumption.

For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variables names are conserved.

This tactic pushes negations inside expressions. For instance, given an assumption
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```

(the pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).
Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every assumption and the goal using `push_neg at *` or at selected assumptions and the goal
using say `push_neg at h h' ⊢` as usual.
-/
unsafe def tactic.interactive.push_neg : parse location → tactic Unit
  | loc.ns loc_l =>
    loc_l.mapM' fun l =>
      match l with
      | some h => do
        push_neg_at_hyp h
        try <|
            interactive.simp_core { eta := ff } failed tt [simp_arg_type.expr ``(PushNeg.not_eq)] []
              (Interactive.Loc.ns [some h])
      | none => do
        push_neg_at_goal
        try sorry
  | loc.wildcard => do
    push_neg_at_goal
    local_context >>= mmap' fun h => push_neg_at_hyp (local_pp_name h)
    try sorry
#align tactic.interactive.push_neg tactic.interactive.push_neg

add_tactic_doc
  { Name := "push_neg"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.push_neg]
    tags := ["logic"] }

theorem imp_of_not_imp_not (P Q : Prop) : (¬Q → ¬P) → P → Q := fun h hP =>
  by_contradiction fun h' => h h' hP
#align imp_of_not_imp_not imp_of_not_imp_not

/-- Matches either an identifier "h" or a pair of identifiers "h with k" -/
unsafe def name_with_opt : lean.parser (Name × Option Name) :=
  Prod.mk <$> ident <*> (some <$> (tk "with" *> ident) <|> return none)
#align name_with_opt name_with_opt

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Transforms the goal into its contrapositive.

      * `contrapose`     turns a goal `P → Q` into `¬ Q → ¬ P`
      * `contrapose!`    turns a goal `P → Q` into `¬ Q → ¬ P` and pushes negations inside `P` and `Q`
        using `push_neg`
      * `contrapose h`   first reverts the local assumption `h`, and then uses `contrapose` and `intro h`
      * `contrapose! h`  first reverts the local assumption `h`, and then uses `contrapose!` and `intro h`
      * `contrapose h with new_h` uses the name `new_h` for the introduced hypothesis
      -/
    unsafe
  def
    tactic.interactive.contrapose
    ( push : parse ( tk "!" ) ? ) : parse name_with_opt ? → tactic Unit
    |
        some ( h , h' )
        =>
        (
            ( ( get_local h >>= revert ) >> tactic.interactive.contrapose none )
              >>
              intro ( h' . getD h )
            )
          >>
          skip
      |
        none
        =>
        do
          let
              q( $ ( P ) → $ ( Q ) )
                ←
                target
                | fail "The goal is not an implication, and you didn't specify an assumption"
            let
              cp
                ←
                mk_mapp ` ` imp_of_not_imp_not [ P , Q ]
                  <|>
                  fail "contrapose only applies to nondependent arrows between props"
            apply cp
            when push <| try ( tactic.interactive.push_neg ( loc.ns [ none ] ) )
#align tactic.interactive.contrapose tactic.interactive.contrapose

add_tactic_doc
  { Name := "contrapose"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.contrapose]
    tags := ["logic"] }

/-!
## `#push_neg` command
A user command to run `push_neg`. Mostly copied from the `#norm_num` and `#simp` commands.
-/

namespace Tactic

open Lean.Parser

open Interactive.Types

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- The syntax is `#push_neg e`, where `e` is an expression,
which will print the `push_neg` form of `e`.

`#push_neg` understands local variables, so you can use them to
introduce parameters.
-/
@[user_command]
unsafe def push_neg_cmd (_ : parse <| tk "#push_neg") : lean.parser Unit := do
  let e ← texpr
  let/- Synthesize a `tactic_state` including local variables as hypotheses under which
         `normalize_negations` may be safely called with expected behaviour given the `variables` in the
         environment. -/
    (ts, _)
    ← synthesize_tactic_state_with_variables_as_hyps [e]
  let result
    ←-- Enter the `tactic` monad, *critically* using the synthesized tactic state `ts`.
        lean.parser.of_tactic
        fun _ =>
        (/- Resolve the local variables added by the parser to `e` (when it was parsed) against the local
                 hypotheses added to the `ts : tactic_state` which we are using. -/
          do
            let e ← to_expr e
            let-- Run `push_neg` on the expression.
              (e_neg, _)
              ← normalize_negations e
            /- Run a `simp` to change any `¬ a = b` to `a ≠ b`; report the result, or, if the `simp` fails
                      (because no `¬ a = b` appear in the expression), return what `push_neg` gave. -/
                  Prod.fst <$>
                  e_neg { eta := ff } failed tt [] [simp_arg_type.expr ``(PushNeg.not_eq)] <|>
                pure e_neg)
          ts
  -- Trace the result.
      trace
      result
#align tactic.push_neg_cmd tactic.push_neg_cmd

add_tactic_doc
  { Name := "#push_neg"
    category := DocCategory.cmd
    declNames := [`tactic.push_neg_cmd]
    tags := ["logic"] }

end Tactic


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.matrix.pequiv
import Mathlib.data.fintype.card
import Mathlib.group_theory.perm.sign
import Mathlib.algebra.algebra.basic
import Mathlib.tactic.ring
import Mathlib.linear_algebra.alternating
import Mathlib.PostPort

universes u v w z u_1

namespace Mathlib

namespace matrix

/-- The determinant of a matrix given by the Leibniz formula. -/
def det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) : R :=
  finset.sum finset.univ
    fun (σ : equiv.perm n) => ↑↑(coe_fn equiv.perm.sign σ) * finset.prod finset.univ fun (i : n) => M (coe_fn σ i) i

@[simp] theorem det_diagonal {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {d : n → R} : det (diagonal d) = finset.prod finset.univ fun (i : n) => d i := sorry

@[simp] theorem det_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (h : Nonempty n) : det 0 = 0 := sorry

@[simp] theorem det_one {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : det 1 = 1 := sorry

theorem det_eq_one_of_card_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {A : matrix n n R} (h : fintype.card n = 0) : det A = 1 := sorry

theorem det_mul_aux {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {M : matrix n n R} {N : matrix n n R} {p : n → n} (H : ¬function.bijective p) : (finset.sum finset.univ
    fun (σ : equiv.perm n) =>
      ↑↑(coe_fn equiv.perm.sign σ) * finset.prod finset.univ fun (x : n) => M (coe_fn σ x) (p x) * N (p x) x) =
  0 := sorry

@[simp] theorem det_mul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) (N : matrix n n R) : det (matrix.mul M N) = det M * det N := sorry

protected instance det.is_monoid_hom {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : is_monoid_hom det :=
  is_monoid_hom.mk det_one

/-- Transposing a matrix preserves the determinant. -/
@[simp] theorem det_transpose {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) : det (transpose M) = det M := sorry

/-- The determinant of a permutation matrix equals its sign. -/
@[simp] theorem det_permutation {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (σ : equiv.perm n) : det (pequiv.to_matrix (equiv.to_pequiv σ)) = ↑(coe_fn equiv.perm.sign σ) := sorry

/-- Permuting the columns changes the sign of the determinant. -/
theorem det_permute {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (σ : equiv.perm n) (M : matrix n n R) : (det fun (i : n) => M (coe_fn σ i)) = ↑(coe_fn equiv.perm.sign σ) * det M := sorry

@[simp] theorem det_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {A : matrix n n R} {c : R} : det (c • A) = c ^ fintype.card n * det A := sorry

theorem ring_hom.map_det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {S : Type w} [comm_ring S] {M : matrix n n R} {f : R →+* S} : coe_fn f (det M) = det (coe_fn (ring_hom.map_matrix f) M) := sorry

theorem alg_hom.map_det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {S : Type w} [comm_ring S] [algebra R S] {T : Type z} [comm_ring T] [algebra R T] {M : matrix n n S} {f : alg_hom R S T} : coe_fn f (det M) = det (coe_fn (ring_hom.map_matrix ↑f) M) := sorry

/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

theorem det_eq_zero_of_row_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {A : matrix n n R} (i : n) (h : ∀ (j : n), A i j = 0) : det A = 0 := sorry

theorem det_eq_zero_of_column_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {A : matrix n n R} (j : n) (h : ∀ (i : n), A i j = 0) : det A = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (det A = 0)) (Eq.symm (det_transpose A)))) (det_eq_zero_of_row_eq_zero j h)

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {M : matrix n n R} {i : n} {j : n} (i_ne_j : i ≠ j) (hij : M i = M j) : det M = 0 := sorry

theorem det_update_column_add {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) (j : n) (u : n → R) (v : n → R) : det (update_column M j (u + v)) = det (update_column M j u) + det (update_column M j v) := sorry

theorem det_update_row_add {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) (j : n) (u : n → R) (v : n → R) : det (update_row M j (u + v)) = det (update_row M j u) + det (update_row M j v) := sorry

theorem det_update_column_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) (j : n) (s : R) (u : n → R) : det (update_column M j (s • u)) = s * det (update_column M j u) := sorry

theorem det_update_row_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) (j : n) (s : R) (u : n → R) : det (update_row M j (s • u)) = s * det (update_row M j u) := sorry

/-- `det` is an alternating multilinear map over the rows of the matrix.

See also `is_basis.det`. -/
def det_row_multilinear {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] : alternating_map R (n → R) R n :=
  alternating_map.mk det sorry sorry sorry

@[simp] theorem det_block_diagonal {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] {o : Type u_1} [fintype o] [DecidableEq o] (M : o → matrix n n R) : det (block_diagonal M) = finset.prod finset.univ fun (k : o) => det (M k) := sorry


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.order.basic
import algebra.order.archimedean

/-!
# Rational numbers are dense in a linear ordered archimedean field

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

In this file we prove that coercion from `ℚ` to a linear ordered archimedean field has dense range.
This lemma is in a separate file because `topology.order.basic` does not import
`algebra.order.archimedean`.
-/

variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜]
  [archimedean 𝕜]

/-- Rational numbers are dense in a linear ordered archimedean field. -/
lemma rat.dense_range_cast : dense_range (coe : ℚ → 𝕜) :=
dense_of_exists_between $ λ a b h, set.exists_range_iff.2 $ exists_rat_btwn h


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.set_theory.game.state
import Mathlib.PostPort

namespace Mathlib

/-!
# Domineering as a combinatorial game.

We define the game of Domineering, played on a chessboard of arbitrary shape
(possibly even disconnected).
Left moves by placing a domino vertically, while Right moves by placing a domino horizontally.

This is only a fragment of a full development;
in order to successfully analyse positions we would need some more theorems.
Most importantly, we need a general statement that allows us to discard irrelevant moves.
Specifically to domineering, we need the fact that
disjoint parts of the chessboard give sums of games.
-/

namespace pgame

namespace domineering

/-- The embedding `(x, y) ↦ (x, y+1)`. -/
def shift_up : ℤ × ℤ ↪ ℤ × ℤ :=
  function.embedding.prod_map (function.embedding.refl ℤ)
    (function.embedding.mk (fun (n : ℤ) => n + 1) sorry)

/-- The embedding `(x, y) ↦ (x+1, y)`. -/
def shift_right : ℤ × ℤ ↪ ℤ × ℤ :=
  function.embedding.prod_map (function.embedding.mk (fun (n : ℤ) => n + 1) sorry)
    (function.embedding.refl ℤ)

/-- A Domineering board is an arbitrary finite subset of `ℤ × ℤ`. -/
def board := finset (ℤ × ℤ)

/-- Left can play anywhere that a square and the square below it are open. -/
/-- Right can play anywhere that a square and the square to the left are open. -/
def left (b : board) : finset (ℤ × ℤ) := b ∩ finset.map shift_up b

def right (b : board) : finset (ℤ × ℤ) := b ∩ finset.map shift_right b

/-- After Left moves, two vertically adjacent squares are removed from the board. -/
def move_left (b : board) (m : ℤ × ℤ) : board :=
  finset.erase (finset.erase b m) (prod.fst m, prod.snd m - 1)

/-- After Left moves, two horizontally adjacent squares are removed from the board. -/
def move_right (b : board) (m : ℤ × ℤ) : board :=
  finset.erase (finset.erase b m) (prod.fst m - 1, prod.snd m)

theorem card_of_mem_left {b : board} {m : ℤ × ℤ} (h : m ∈ left b) : bit0 1 ≤ finset.card b := sorry

theorem card_of_mem_right {b : board} {m : ℤ × ℤ} (h : m ∈ right b) : bit0 1 ≤ finset.card b :=
  sorry

theorem move_left_card {b : board} {m : ℤ × ℤ} (h : m ∈ left b) :
    finset.card (move_left b m) + bit0 1 = finset.card b :=
  sorry

theorem move_right_card {b : board} {m : ℤ × ℤ} (h : m ∈ right b) :
    finset.card (move_right b m) + bit0 1 = finset.card b :=
  sorry

theorem move_left_smaller {b : board} {m : ℤ × ℤ} (h : m ∈ left b) :
    finset.card (move_left b m) / bit0 1 < finset.card b / bit0 1 :=
  sorry

theorem move_right_smaller {b : board} {m : ℤ × ℤ} (h : m ∈ right b) :
    finset.card (move_right b m) / bit0 1 < finset.card b / bit0 1 :=
  sorry

/-- The instance describing allowed moves on a Domineering board. -/
protected instance state : state board :=
  state.mk (fun (s : board) => finset.card s / bit0 1)
    (fun (s : board) => finset.image (move_left s) (left s))
    (fun (s : board) => finset.image (move_right s) (right s)) sorry sorry

end domineering

/-- Construct a pre-game from a Domineering board. -/
def domineering (b : domineering.board) : pgame := of b

/-- All games of Domineering are short, because each move removes two squares. -/
protected instance short_domineering (b : domineering.board) : short (domineering b) :=
  id (pgame.short_of b)

/-- The Domineering board with two squares arranged vertically, in which Left has the only move. -/
def domineering.one : pgame := domineering (list.to_finset [(0, 0), (0, 1)])

/-- The `L` shaped Domineering board, in which Left is exactly half a move ahead. -/
def domineering.L : pgame := domineering (list.to_finset [(0, bit0 1), (0, 1), (0, 0), (1, 0)])

protected instance short_one : short domineering.one :=
  id (pgame.short_domineering (list.to_finset [(0, 0), (0, 1)]))

protected instance short_L : short domineering.L :=
  id (pgame.short_domineering (list.to_finset [(0, bit0 1), (0, 1), (0, 0), (1, 0)]))

end Mathlib


import data.int.basic

variables a b c d : ℤ

#check -a

example : a + 0 = a := add_zero a
example : 0 + a = a := zero_add a
example : a * 1 = a := mul_one a
example : 1 * a = a := one_mul a
example : -a + a = 0 := neg_add_self a
example : a + -a = 0 := add_neg_self a
example : a - a = 0 := sub_self a
example : a + b = b + a := add_comm a b
example : a + b + c = a + (b + c) := add_assoc a b c
example : a * b = b * a := mul_comm a b
example : a * b * c = a * (b * c) := mul_assoc a b c
example : a * (b + c) = a * b + a * c := mul_add a b c
example : a * (b + c) = a * b + a * c := left_distrib a b c
example : (a + b) * c = a * c + b * c := add_mul a b c
example : (a + b) * c = a * c + b * c := right_distrib a b c
example : a * (b - c) = a * b - a * c := mul_sub a b c
example : (a - b) * c = a * c - b * c := sub_mul a b c

variables x y z : ℤ

example (x y z : ℕ) : x * (y + z) = x * y + x * z := mul_add x y z
example (x y z : ℕ) : (x + y) * z = x * z + y * z := add_mul x y z
example (x y z : ℕ) : x + y + z = x + (y + z) := add_assoc x y z

#check mul_add x y z

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
have h1 : (x + y) * (x + y) = (x + y) * x + (x + y) * y,
  from mul_add (x + y) x y,
have h2 : (x + y) * (x + y) = x * x + y * x + (x * y + y * y),
  from (add_mul x y x) ▸ (add_mul x y y) ▸ h1,
h2.trans (add_assoc (x * x + y * x) (x * y) (y * y)).symm


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import analysis.convex.combination
import linear_algebra.affine_space.independent
import tactic.field_simp

/-!
# Carathéodory's convexity theorem

Convex hull can be regarded as a refinement of affine span. Both are closure operators but whereas
convex hull takes values in the lattice of convex subsets, affine span takes values in the much
coarser sublattice of affine subspaces.

The cost of this refinement is that one no longer has bases. However Carathéodory's convexity
theorem offers some compensation. Given a set `s` together with a point `x` in its convex hull,
Carathéodory says that one may find an affine-independent family of elements `s` whose convex hull
contains `x`. Thus the difference from the case of affine span is that the affine-independent family
depends on `x`.

In particular, in finite dimensions Carathéodory's theorem implies that the convex hull of a set `s`
in `𝕜ᵈ` is the union of the convex hulls of the `(d + 1)`-tuples in `s`.

## Main results

* `convex_hull_eq_union`: Carathéodory's convexity theorem

## Implementation details

This theorem was formalized as part of the Sphere Eversion project.

## Tags
convex hull, caratheodory

-/

open set finset
open_locale big_operators

universes u
variables {𝕜 : Type*} {E : Type u} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E]

namespace caratheodory

/-- If `x` is in the convex hull of some finset `t` whose elements are not affine-independent,
then it is in the convex hull of a strict subset of `t`. -/
lemma mem_convex_hull_erase [decidable_eq E] {t : finset E}
  (h : ¬ affine_independent 𝕜 (coe : t → E)) {x : E} (m : x ∈ convex_hull 𝕜 (↑t : set E)) :
  ∃ (y : (↑t : set E)), x ∈ convex_hull 𝕜 (↑(t.erase y) : set E) :=
begin
  simp only [finset.convex_hull_eq, mem_set_of_eq] at m ⊢,
  obtain ⟨f, fpos, fsum, rfl⟩ := m,
  obtain ⟨g, gcombo, gsum, gpos⟩ := exists_nontrivial_relation_sum_zero_of_not_affine_ind h,
  replace gpos := exists_pos_of_sum_zero_of_exists_nonzero g gsum gpos,
  clear h,
  let s := @finset.filter _ (λ z, 0 < g z) (λ _, linear_order.decidable_lt _ _) t,
  obtain ⟨i₀, mem, w⟩ : ∃ i₀ ∈ s, ∀ i ∈ s, f i₀ / g i₀ ≤ f i / g i,
  { apply s.exists_min_image (λ z, f z / g z),
    obtain ⟨x, hx, hgx⟩ : ∃ x ∈ t, 0 < g x := gpos,
    exact ⟨x, mem_filter.mpr ⟨hx, hgx⟩⟩ },
  have hg   : 0 < g i₀ := by { rw mem_filter at mem, exact mem.2 },
  have hi₀  : i₀ ∈ t   := filter_subset _ _ mem,
  let  k    : E → 𝕜    := λ z, f z - (f i₀ / g i₀) * g z,
  have hk   : k i₀ = 0 := by field_simp [k, ne_of_gt hg],
  have ksum : ∑ e in t.erase i₀, k e = 1,
  { calc ∑ e in t.erase i₀, k e = ∑ e in t, k e :
      by conv_rhs { rw [← insert_erase hi₀, sum_insert (not_mem_erase i₀ t), hk, zero_add] }
    ... = ∑ e in t, (f e - f i₀ / g i₀ * g e) : rfl
    ... = 1 : by rw [sum_sub_distrib, fsum, ← mul_sum, gsum, mul_zero, sub_zero] },
  refine ⟨⟨i₀, hi₀⟩, k, _, by convert ksum, _⟩,
  { simp only [and_imp, sub_nonneg, mem_erase, ne.def, subtype.coe_mk],
    intros e hei₀ het,
    by_cases hes : e ∈ s,
    { have hge : 0 < g e := by { rw mem_filter at hes, exact hes.2 },
      rw ← le_div_iff hge,
      exact w _ hes },
    { calc _ ≤ 0   : mul_nonpos_of_nonneg_of_nonpos _ _ -- prove two goals below
         ... ≤ f e : fpos e het,
      { apply div_nonneg (fpos i₀ (mem_of_subset (filter_subset _ t) mem)) (le_of_lt hg) },
      { simpa only [mem_filter, het, true_and, not_lt] using hes } } },
  { simp only [subtype.coe_mk, center_mass_eq_of_sum_1 _ id ksum, id],
    calc ∑ e in t.erase i₀, k e • e = ∑ e in t, k e • e : sum_erase _ (by rw [hk, zero_smul])
    ... = ∑ e in t, (f e - f i₀ / g i₀ * g e) • e : rfl
    ... = t.center_mass f id : _,
    simp only [sub_smul, mul_smul, sum_sub_distrib, ← smul_sum, gcombo, smul_zero,
      sub_zero, center_mass, fsum, inv_one, one_smul, id.def] }
end

variables {s : set E} {x : E} (hx : x ∈ convex_hull 𝕜 s)
include hx

/-- Given a point `x` in the convex hull of a set `s`, this is a finite subset of `s` of minimum
cardinality, whose convex hull contains `x`. -/
noncomputable def min_card_finset_of_mem_convex_hull : finset E :=
function.argmin_on finset.card nat.lt_wf { t | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) }
(by simpa only [convex_hull_eq_union_convex_hull_finite_subsets s, exists_prop, mem_Union] using hx)

lemma min_card_finset_of_mem_convex_hull_subseteq : ↑(min_card_finset_of_mem_convex_hull hx) ⊆ s :=
(function.argmin_on_mem _ _ { t : finset E | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) } _).1

lemma mem_min_card_finset_of_mem_convex_hull :
  x ∈ convex_hull 𝕜 (min_card_finset_of_mem_convex_hull hx : set E) :=
(function.argmin_on_mem _ _ { t : finset E | ↑t ⊆ s ∧ x ∈ convex_hull 𝕜 (t : set E) } _).2

lemma min_card_finset_of_mem_convex_hull_nonempty :
  (min_card_finset_of_mem_convex_hull hx).nonempty :=
begin
  rw [← finset.coe_nonempty, ← @convex_hull_nonempty_iff 𝕜],
  exact ⟨x, mem_min_card_finset_of_mem_convex_hull hx⟩,
end

lemma min_card_finset_of_mem_convex_hull_card_le_card
  {t : finset E} (ht₁ : ↑t ⊆ s) (ht₂ : x ∈ convex_hull 𝕜 (t : set E)) :
  (min_card_finset_of_mem_convex_hull hx).card ≤ t.card :=
function.argmin_on_le _ _ _ ⟨ht₁, ht₂⟩

lemma affine_independent_min_card_finset_of_mem_convex_hull :
  affine_independent 𝕜 (coe : min_card_finset_of_mem_convex_hull hx → E) :=
begin
  let k := (min_card_finset_of_mem_convex_hull hx).card - 1,
  have hk : (min_card_finset_of_mem_convex_hull hx).card = k + 1,
  { exact (nat.succ_pred_eq_of_pos
      (finset.card_pos.mpr (min_card_finset_of_mem_convex_hull_nonempty hx))).symm },
  classical,
  by_contra,
  obtain ⟨p, hp⟩ := mem_convex_hull_erase h (mem_min_card_finset_of_mem_convex_hull hx),
  have contra := min_card_finset_of_mem_convex_hull_card_le_card hx (set.subset.trans
    (finset.erase_subset ↑p (min_card_finset_of_mem_convex_hull hx))
    (min_card_finset_of_mem_convex_hull_subseteq hx)) hp,
  rw [← not_lt] at contra,
  apply contra,
  erw [card_erase_of_mem p.2, hk],
  exact lt_add_one _,
end

end caratheodory

variables {s : set E}

/-- **Carathéodory's convexity theorem** -/
lemma convex_hull_eq_union :
  convex_hull 𝕜 s =
  ⋃ (t : finset E) (hss : ↑t ⊆ s) (hai : affine_independent 𝕜 (coe : t → E)), convex_hull 𝕜 ↑t :=
begin
  apply set.subset.antisymm,
  { intros x hx,
    simp only [exists_prop, set.mem_Union],
    exact ⟨caratheodory.min_card_finset_of_mem_convex_hull hx,
           caratheodory.min_card_finset_of_mem_convex_hull_subseteq hx,
           caratheodory.affine_independent_min_card_finset_of_mem_convex_hull hx,
           caratheodory.mem_min_card_finset_of_mem_convex_hull hx⟩ },
  { iterate 3 { convert set.Union_subset _, intro },
    exact convex_hull_mono ‹_› }
end

/-- A more explicit version of `convex_hull_eq_union`. -/
theorem eq_pos_convex_span_of_mem_convex_hull {x : E} (hx : x ∈ convex_hull 𝕜 s) :
  ∃ (ι : Sort (u+1)) (_ : fintype ι), by exactI ∃ (z : ι → E) (w : ι → 𝕜)
    (hss : set.range z ⊆ s) (hai : affine_independent 𝕜 z)
    (hw : ∀ i, 0 < w i), ∑ i, w i = 1 ∧ ∑ i, w i • z i = x :=
begin
  rw convex_hull_eq_union at hx,
  simp only [exists_prop, set.mem_Union] at hx,
  obtain ⟨t, ht₁, ht₂, ht₃⟩ := hx,
  simp only [t.convex_hull_eq, exists_prop, set.mem_set_of_eq] at ht₃,
  obtain ⟨w, hw₁, hw₂, hw₃⟩ := ht₃,
  let t' := t.filter (λ i, w i ≠ 0),
  refine ⟨t', t'.fintype_coe_sort, (coe : t' → E), w ∘ (coe : t' → E), _, _, _, _, _⟩,
  { rw subtype.range_coe_subtype, exact subset.trans (finset.filter_subset _ t) ht₁ },
  { exact ht₂.comp_embedding
      ⟨_, inclusion_injective (finset.filter_subset (λ i, w i ≠ 0) t)⟩ },
  { exact λ i, (hw₁ _ (finset.mem_filter.mp i.2).1).lt_of_ne
      (finset.mem_filter.mp i.property).2.symm },
  { erw [finset.sum_attach, finset.sum_filter_ne_zero, hw₂] },
  { change ∑ (i : t') in t'.attach, (λ e, w e • e) ↑i = x,
    erw [finset.sum_attach, finset.sum_filter_of_ne],
    { rw t.center_mass_eq_of_sum_1 id hw₂ at hw₃, exact hw₃ },
    { intros e he hwe contra, apply hwe, rw [contra, zero_smul] } }
end


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

import ring_theory.ideal.operations
import topology.algebra.nonarchimedean.bases
import topology.algebra.uniform_ring
/-!
# Adic topology

Given a commutative ring `R` and an ideal `I` in `R`, this file constructs the unique
topology on `R` which is compatible with the ring structure and such that a set is a neighborhood
of zero if and only if it contains a power of `I`. This topology is non-archimedean: every
neighborhood of zero contains an open subgroup, namely a power of `I`.

It also studies the predicate `is_adic` which states that a given topological ring structure is
adic, proving a characterization and showing that raising an ideal to a positive power does not
change the associated topology.

Finally, it defines `with_ideal`, a class registering an ideal in a ring and providing the
corresponding adic topology to the type class inference system.

## Main definitions and results

* `ideal.adic_basis`: the basis of submodules given by powers of an ideal.
* `ideal.adic_topology`: the adic topology associated to an ideal. It has the above basis
  for neighborhoods of zero.
* `ideal.nonarchimedean`: the adic topology is non-archimedean
* `is_ideal_adic_iff`: A topological ring is `J`-adic if and only if it admits the powers of `J` as
  a basis of open neighborhoods of zero.
* `with_ideal`: a class registering an ideal in a ring.

## Implementation notes

The `I`-adic topology on a ring `R` has a contrived definition using `I^n • ⊤` instead of `I`
to make sure it is definitionally equal to the `I`-topology on `R` seen as a `R`-module.

-/

variables {R : Type*} [comm_ring R]

open set topological_add_group submodule filter
open_locale topological_space pointwise

namespace ideal

lemma adic_basis (I : ideal R) : submodules_ring_basis (λ n : ℕ, (I^n • ⊤ : ideal R)) :=
{ inter := begin
    suffices : ∀ i j : ℕ, ∃ k, I ^ k ≤ I ^ i ∧ I ^ k ≤ I ^ j, by simpa,
    intros i j,
    exact ⟨max i j, pow_le_pow (le_max_left i j), pow_le_pow (le_max_right i j)⟩
  end,
  left_mul := begin
    suffices : ∀ (a : R) (i : ℕ), ∃ j : ℕ, a • I ^ j ≤ I ^ i,  by simpa,
    intros r n,
    use n,
    rintro a ⟨x, hx, rfl⟩,
    exact (I ^ n).smul_mem r hx
  end,
  mul := begin
    suffices : ∀ (i : ℕ), ∃ (j : ℕ), ↑(I ^ j) * ↑(I ^ j) ⊆ ↑(I ^ i), by simpa,
    intro n,
    use n,
    rintro a ⟨x, b, hx, hb, rfl⟩,
    exact (I^n).smul_mem x hb
  end }

/-- The adic ring filter basis associated to an ideal `I` is made of powers of `I`. -/
def ring_filter_basis (I : ideal R) := I.adic_basis.to_ring_subgroups_basis.to_ring_filter_basis

/-- The adic topology associated to an ideal `I`. This topology admits powers of `I` as a basis of
neighborhoods of zero. It is compatible with the ring structure and is non-archimedean. -/
def adic_topology (I : ideal R) : topological_space R :=
(adic_basis I).topology

lemma nonarchimedean (I : ideal R) : @nonarchimedean_ring R _ I.adic_topology :=
I.adic_basis.to_ring_subgroups_basis.nonarchimedean

/-- For the `I`-adic topology, the neighborhoods of zero has basis given by the powers of `I`. -/
lemma has_basis_nhds_zero_adic (I : ideal R) :
  has_basis (@nhds R I.adic_topology (0 : R)) (λ n : ℕ, true) (λ n, ((I^n : ideal R) : set R)) :=
⟨begin
  intros U,
  rw I.ring_filter_basis.to_add_group_filter_basis.nhds_zero_has_basis.mem_iff,
  split,
  { rintros ⟨-, ⟨i, rfl⟩, h⟩,
    replace h : ↑(I ^ i) ⊆ U := by simpa using h,
    use [i, trivial, h] },
  { rintros ⟨i, -, h⟩,
    exact ⟨(I^i : ideal R), ⟨i, by simp⟩, h⟩ }
end⟩

variables (I : ideal R) (M : Type*) [add_comm_group M] [module R M]

lemma adic_module_basis  :
  I.ring_filter_basis.submodules_basis (λ n : ℕ, (I^n) • (⊤ : submodule R M)) :=
{ inter := λ i j, ⟨max i j, le_inf_iff.mpr ⟨smul_mono_left $ pow_le_pow (le_max_left i j),
                                            smul_mono_left $ pow_le_pow (le_max_right i j)⟩⟩,
  smul := λ m i, ⟨(I^i • ⊤ : ideal R), ⟨i, rfl⟩,
                  λ a a_in, by { replace a_in : a ∈ I^i := by simpa [(I^i).mul_top] using a_in,
                                 exact smul_mem_smul a_in mem_top }⟩ }

/-- The topology on a `R`-module `M` associated to an ideal `M`. Submodules $I^n M$,
written `I^n • ⊤` form a basis of neighborhoods of zero. -/
def adic_module_topology : topological_space M :=
  @module_filter_basis.topology R M _ I.adic_basis.topology _ _
  (I.ring_filter_basis.module_filter_basis (I.adic_module_basis M))

/-- The elements of the basis of neighborhoods of zero for the `I`-adic topology
on a `R`-module `M`, seen as open additive subgroups of `M`. -/
def open_add_subgroup (n : ℕ) : @open_add_subgroup R _ I.adic_topology :=
{ is_open' := begin
    letI := I.adic_topology,
    convert (I.adic_basis.to_ring_subgroups_basis.open_add_subgroup n).is_open,
    simp
  end,
  ..(I^n).to_add_subgroup}

end ideal

section is_adic

/-- Given a topology on a ring `R` and an ideal `J`, `is_adic J` means the topology is the
`J`-adic one. -/
def is_adic [H : topological_space R] (J : ideal R) : Prop :=
H = J.adic_topology

/-- A topological ring is `J`-adic if and only if it admits the powers of `J` as a basis of
open neighborhoods of zero. -/
lemma is_adic_iff [top : topological_space R] [topological_ring R] {J : ideal R} :
  is_adic J ↔ (∀ n : ℕ, is_open ((J^n : ideal R) : set R)) ∧
              (∀ s ∈ 𝓝 (0 : R), ∃ n : ℕ, ((J^n : ideal R) : set R) ⊆ s) :=
begin
  split,
  { intro H,
    change _ = _ at H,
    rw H,
    letI := J.adic_topology,
    split,
    { intro n,
      exact (J.open_add_subgroup n).is_open' },
    { intros s hs,
      simpa using J.has_basis_nhds_zero_adic.mem_iff.mp hs } },
  { rintro ⟨H₁, H₂⟩,
    apply topological_add_group.ext,
    { apply @topological_ring.to_topological_add_group },
    { apply (ring_subgroups_basis.to_ring_filter_basis _).to_add_group_filter_basis
             .is_topological_add_group },
    { ext s,
      letI := ideal.adic_basis J,
      rw J.has_basis_nhds_zero_adic.mem_iff,
      split; intro H,
      { rcases H₂ s H with ⟨n, h⟩,
        use [n, trivial, h] },
      { rcases H with ⟨n, -, hn⟩,
        rw mem_nhds_iff,
        refine ⟨_, hn, H₁ n, (J^n).zero_mem⟩ } } }
end

variables [topological_space R] [topological_ring R]

lemma is_ideal_adic_pow {J : ideal R} (h : is_adic J) {n : ℕ} (hn : 0 < n) :
  is_adic (J^n) :=
begin
  rw is_adic_iff at h ⊢,
  split,
  { intro m, rw ← pow_mul, apply h.left },
  { intros V hV,
    cases h.right V hV with m hm,
    use m,
    refine set.subset.trans _ hm,
    cases n, { exfalso, exact nat.not_succ_le_zero 0 hn },
    rw [← pow_mul, nat.succ_mul],
    apply ideal.pow_le_pow,
    apply nat.le_add_left }
end

lemma is_bot_adic_iff {A : Type*} [comm_ring A] [topological_space A] [topological_ring A] :
is_adic (⊥ : ideal A) ↔ discrete_topology A :=
begin
  rw is_adic_iff,
  split,
  { rintro ⟨h, h'⟩,
    rw discrete_topology_iff_open_singleton_zero,
    simpa using h 1 },
  { introsI,
    split,
    { simp, },
    { intros U U_nhds,
      use 1,
      simp [mem_of_mem_nhds U_nhds] } },
end

end is_adic

/-- The ring `R` is equipped with a preferred ideal. -/
class with_ideal (R : Type*) [comm_ring R] :=
(I : ideal R)

namespace with_ideal

variables (R) [with_ideal R]

@[priority 100] instance : topological_space R := I.adic_topology

@[priority 100] instance : nonarchimedean_ring R := ring_subgroups_basis.nonarchimedean _
@[priority 100] instance : uniform_space R :=
topological_add_group.to_uniform_space R

@[priority 100] instance : uniform_add_group R :=
topological_add_group_is_uniform

/-- The adic topology on a `R` module coming from the ideal `with_ideal.I`.
This cannot be an instance because `R` cannot be inferred from `M`. -/
def topological_space_module (M : Type*) [add_comm_group M] [module R M] :
  topological_space M := (I : ideal R).adic_module_topology M

/-
The next examples are kept to make sure potential future refactors won't break the instance
chaining.
-/

example : nonarchimedean_ring R :=
by apply_instance

example : topological_ring (uniform_space.completion R) :=
by apply_instance

example (M : Type*) [add_comm_group M] [module R M] :
  @topological_add_group M (with_ideal.topological_space_module R M) _:=
by apply_instance

example (M : Type*) [add_comm_group M] [module R M] :
  @has_continuous_smul R M _ _ (with_ideal.topological_space_module R M) :=
by apply_instance

example (M : Type*) [add_comm_group M] [module R M] :
  @nonarchimedean_add_group M _ (with_ideal.topological_space_module R M) :=
submodules_basis.nonarchimedean _

end with_ideal