import assign
import simplify

lemma reduces (f : formula) (l : literal)
  (h : l ∈ f.join ∨ l_not l ∈ f.join) :
  formula_size (simplify (assign_lit l f)) < formula_size f :=
begin
  have first_assign : formula_size (assign_lit l f) < formula_size f :=
    assign_with_present_reduces_size _ _ h,
  have leq := simplify_leq_size (assign_lit l f),
  linarith,
end

def compute_sat (g : choice_func) : formula → bool
| [] := tt
| f :=

  -- this line is here just to make proving things easier
  if h : f.join = [] then ff else

  if [] ∈ f then ff else
  let non_empty_f := (subtype.mk f h) in
  let l := g.val non_empty_f in
  have in_joined : l ∈ f.join ∨ l_not l ∈ f.join :=
    by apply g.property non_empty_f,
  have in_joined_flip : l_not l ∈ f.join ∨ l_not (l_not l) ∈ f.join :=
  begin
    apply or.symm,
    rw l_inv,
    exact in_joined,
  end,

  have first : formula_size (simplify (assign_lit l f))
      < formula_size f := reduces _ _ in_joined,
  have second : formula_size (simplify (assign_lit (l_not l) f))
      < formula_size f := reduces _ _ in_joined_flip,

  compute_sat (simplify (assign_lit l f)) ||
    compute_sat (simplify (assign_lit (l_not l) f))
using_well_founded {rel_tac := λ _ _,
                    `[exact ⟨_, measure_wf formula_size⟩]}

#eval compute_sat naive_choice_func example_sat_formula
#eval compute_sat naive_choice_func example_unsat_formula
#eval compute_sat naive_choice_func example_complex_formula

theorem compute_sat_correct (f : formula) (g : choice_func) :
  (compute_sat g f = tt) ↔ sat f :=
begin
  induction h_eq : (formula_size f) using nat.strong_induction_on
    with n ih generalizing f,
  cases' f,
  {
    rw compute_sat,
    simp,
    let empty_a : assignment := subtype.mk [] (by simp),
    apply exists.intro empty_a,
    rw formula_sat,
    simp,
  },
  {
    have nil_in_implies_unsat : [] ∈ hd :: f →  ¬ sat (hd :: f) := begin
      intro nil_in,
      intro is_sat,
      cases' is_sat,
      have is_sat := h [] nil_in,
      rw clause_sat at is_sat,
      simp at is_sat,
      contradiction,
    end,

    cases' classical.em ((hd :: f).join = []),
    {
      have is_false : compute_sat g (hd :: f) = ff := begin
        rw compute_sat,
        rw dif_pos,
        exact h,
      end,

      rw is_false,
      simp,

      apply nil_in_implies_unsat,
      simp at h,
      cases' h,
      rw left,
      simp,
    },
    cases' classical.em ([] ∈ (hd :: f)) with nil_in nil_n_in,
    {
      rw compute_sat,
      simp [h, nil_in],
      exact nil_in_implies_unsat nil_in,
    },
    {
      rw compute_sat,
      simp [h, nil_n_in],

      let non_empty_f : non_empty_formula := ⟨hd :: f, h⟩,
      let l := (g.val non_empty_f),

      have in_joined : l ∈ (hd :: f).join ∨ l_not l ∈ (hd :: f).join :=
        by apply g.property non_empty_f,
      have in_joined_flip : l_not l ∈ (hd :: f).join ∨
          l_not (l_not l) ∈ (hd :: f).join :=
      begin
        apply or.symm,
        rw l_inv,
        exact in_joined,
      end,

      have first : formula_size (simplify (assign_lit l (hd :: f))) <
          formula_size (hd :: f) :=
        reduces _ _ in_joined,
      have second : formula_size (simplify (assign_lit (l_not l) (hd :: f))) <
          formula_size (hd :: f) :=
        reduces _ _ in_joined_flip,

      apply iff.intro,
      {
        intro h_or,
        cases' h_or,
        {
          let sub_f := simplify (assign_lit l (hd :: f)),
          let m := formula_size (simplify (assign_lit l (hd :: f))),
          have ih := ih m (begin
            rw ←h_eq,
            simp only [m],
            exact first,
          end) sub_f (by refl),
          have is_true : compute_sat g sub_f = tt := by apply h_1,
          rw is_true at ih,
          simp at ih,
          rw simplify_correct at ih,
          apply assign_sat_implies_sat _ _ ih,
        },
        -- TODO: dedup?
        {
          let sub_f := simplify (assign_lit (l_not l) (hd :: f)),
          let m := formula_size (simplify (assign_lit (l_not l) (hd :: f))),
          have ih := ih m (begin
            rw ←h_eq,
            simp only [m],
            exact second,
          end) sub_f (by refl),
          have is_true : compute_sat g sub_f = tt := by apply h_1,
          rw is_true at ih,
          simp at ih,
          rw simplify_correct at ih,
          apply assign_sat_implies_sat _ _ ih,
        },
      },
      {
        intro is_sat,
        cases' is_sat,
        cases' classical.em (l ∈ w ∨ l_not l ∈ w),
        {
          cases' h_2,
          {
            apply or.inl,
            let sub_f := simplify (assign_lit l (hd :: f)),
            let m := formula_size (simplify (assign_lit l (hd :: f))),
            have ih := ih m (begin
              rw ←h_eq,
              simp only [m],
              exact first,
            end) sub_f (by refl),
            simp only [sub_f, l] at ih,
            simp at ih,
            rw simplify_correct at ih,
            rw ih,
            apply sat_implies_assign_sat_or_cant_exist,
            apply exists.intro w,
            simp [h_1],
            apply h_2,
          },
          -- TODO: dedup?
          {
            apply or.inr,
            let sub_f := simplify (assign_lit (l_not l) (hd :: f)),
            let m := formula_size (simplify (assign_lit (l_not l) (hd :: f))),
            have ih := ih m (begin
              rw ←h_eq,
              simp only [m],
              exact second,
            end) sub_f (by refl),
            simp only [sub_f, l] at ih,
            simp at ih,
            rw simplify_correct at ih,
            rw ih,
            apply sat_implies_assign_sat_or_cant_exist,
            apply exists.intro w,
            simp [h_1],
            apply h_2,
          },
        },
        {
          -- TODO: dedup?
          apply or.inl,
          let sub_f := simplify (assign_lit l (hd :: f)),
          let m := formula_size (simplify (assign_lit l (hd :: f))),
          have ih := ih m (begin
            rw ←h_eq,
            simp only [m],
            exact first,
          end) sub_f (by refl),
          simp only [sub_f, l] at ih,
          simp at ih,
          rw simplify_correct at ih,
          rw ih,
          apply general_assign_sub _ _ _ h_1,
          apply or.inr (or.inr h_2),
        },
      },
    },
  },
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.analytic.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Linear functions are analytic

In this file we prove that a `continuous_linear_map` defines an analytic function with
the formal power series `f x = f a + f (x - a)`.
-/

namespace continuous_linear_map

/-- Formal power series of a continuous linear map `f : E →L[𝕜] F` at `x : E`:
`f y = f x + f (y - x)`. -/
@[simp] def fpower_series {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) (x : E) : formal_multilinear_series 𝕜 E F :=
  sorry

@[simp] theorem fpower_series_apply_add_two {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] (f : continuous_linear_map 𝕜 E F) (x : E) (n : ℕ) :
    fpower_series f x (n + bit0 1) = 0 :=
  rfl

@[simp] theorem fpower_series_radius {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) (x : E) :
    formal_multilinear_series.radius (fpower_series f x) = ⊤ :=
  formal_multilinear_series.radius_eq_top_of_forall_image_add_eq_zero (fpower_series f x) (bit0 1)
    fun (n : ℕ) => rfl

protected theorem has_fpower_series_on_ball {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] (f : continuous_linear_map 𝕜 E F) (x : E) :
    has_fpower_series_on_ball (⇑f) (fpower_series f x) x ⊤ :=
  sorry

protected theorem has_fpower_series_at {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) (x : E) : has_fpower_series_at (⇑f) (fpower_series f x) x :=
  Exists.intro ⊤ (continuous_linear_map.has_fpower_series_on_ball f x)

protected theorem analytic_at {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (f : continuous_linear_map 𝕜 E F) (x : E) : analytic_at 𝕜 (⇑f) x :=
  has_fpower_series_at.analytic_at (continuous_linear_map.has_fpower_series_at f x)

end Mathlib


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.localization_localization
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.AtPrime
import Mathbin.RingTheory.Localization.Basic
import Mathbin.RingTheory.Localization.FractionRing

/-!
# Localizations of localizations

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

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

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

open Function

open BigOperators

namespace IsLocalization

section LocalizationLocalization

variable (M)

variable (N : Submonoid S) (T : Type _) [CommRing T] [Algebra R T]

section

variable [Algebra S T] [IsScalarTower R S T]

-- This should only be defined when `S` is the localization `M⁻¹R`, hence the nolint.
/-- Localizing wrt `M ⊆ R` and then wrt `N ⊆ S = M⁻¹R` is equal to the localization of `R` wrt this
module. See `localization_localization_is_localization`.
-/
@[nolint unused_arguments]
def localizationLocalizationSubmodule : Submonoid R :=
  (N ⊔ M.map (algebraMap R S)).comap (algebraMap R S)
#align is_localization.localization_localization_submodule IsLocalization.localizationLocalizationSubmodule

variable {M N}

@[simp]
theorem mem_localizationLocalizationSubmodule {x : R} :
    x ∈ localizationLocalizationSubmodule M N ↔
      ∃ (y : N)(z : M), algebraMap R S x = y * algebraMap R S z :=
  by
  rw [localization_localization_submodule, Submonoid.mem_comap, Submonoid.mem_sup]
  constructor
  · rintro ⟨y, hy, _, ⟨z, hz, rfl⟩, e⟩
    exact ⟨⟨y, hy⟩, ⟨z, hz⟩, e.symm⟩
  · rintro ⟨y, z, e⟩
    exact ⟨y, y.prop, _, ⟨z, z.prop, rfl⟩, e.symm⟩
#align is_localization.mem_localization_localization_submodule IsLocalization.mem_localizationLocalizationSubmodule

variable (M N) [IsLocalization M S]

theorem localization_localization_map_units [IsLocalization N T]
    (y : localizationLocalizationSubmodule M N) : IsUnit (algebraMap R T y) :=
  by
  obtain ⟨y', z, eq⟩ := mem_localization_localization_submodule.mp y.prop
  rw [IsScalarTower.algebraMap_apply R S T, Eq, RingHom.map_mul, IsUnit.mul_iff]
  exact ⟨IsLocalization.map_units T y', (IsLocalization.map_units _ z).map (algebraMap S T)⟩
#align is_localization.localization_localization_map_units IsLocalization.localization_localization_map_units

theorem localization_localization_surj [IsLocalization N T] (x : T) :
    ∃ y : R × localizationLocalizationSubmodule M N, x * algebraMap R T y.2 = algebraMap R T y.1 :=
  by
  rcases IsLocalization.surj N x with ⟨⟨y, s⟩, eq₁⟩
  -- x = y / s
  rcases IsLocalization.surj M y with ⟨⟨z, t⟩, eq₂⟩
  -- y = z / t
  rcases IsLocalization.surj M (s : S) with ⟨⟨z', t'⟩, eq₃⟩
  -- s = z' / t'
  dsimp only at eq₁ eq₂ eq₃
  use z * t'; use z' * t
  -- x = y / s = (z * t') / (z' * t)
  · rw [mem_localization_localization_submodule]
    refine' ⟨s, t * t', _⟩
    rw [RingHom.map_mul, ← eq₃, mul_assoc, ← RingHom.map_mul, mul_comm t, Submonoid.coe_mul]
  · simp only [Subtype.coe_mk, RingHom.map_mul, IsScalarTower.algebraMap_apply R S T, ← eq₃, ← eq₂,
      ← eq₁]
    ring
#align is_localization.localization_localization_surj IsLocalization.localization_localization_surj

theorem localization_localization_eq_iff_exists [IsLocalization N T] (x y : R) :
    algebraMap R T x = algebraMap R T y ↔
      ∃ c : localizationLocalizationSubmodule M N, ↑c * x = ↑c * y :=
  by
  rw [IsScalarTower.algebraMap_apply R S T, IsScalarTower.algebraMap_apply R S T,
    IsLocalization.eq_iff_exists N T]
  constructor
  · rintro ⟨z, eq₁⟩
    rcases IsLocalization.surj M (z : S) with ⟨⟨z', s⟩, eq₂⟩
    dsimp only at eq₂
    obtain ⟨c, eq₃ : ↑c * (x * z') = ↑c * (y * z')⟩ := (IsLocalization.eq_iff_exists M S).mp _
    swap
    · rw [map_mul, map_mul, ← eq₂, ← mul_assoc, ← mul_assoc, mul_comm _ ↑z, eq₁, mul_comm _ ↑z]
    use c * z'
    · rw [mem_localization_localization_submodule]
      refine' ⟨z, c * s, _⟩
      rw [map_mul, ← eq₂, Submonoid.coe_mul, map_mul, mul_left_comm]
    · rwa [mul_comm _ z', mul_comm _ z', ← mul_assoc, ← mul_assoc] at eq₃
  · rintro ⟨⟨c, hc⟩, eq₁ : c * x = c * y⟩
    rw [mem_localization_localization_submodule] at hc
    rcases hc with ⟨z₁, z, eq₂⟩
    use z₁
    refine' (IsLocalization.map_units S z).mul_right_inj.mp _
    rw [← mul_assoc, mul_comm _ ↑z₁, ← eq₂, ← map_mul, eq₁, map_mul, eq₂, ← mul_assoc,
      mul_comm _ ↑z₁]
#align is_localization.localization_localization_eq_iff_exists IsLocalization.localization_localization_eq_iff_exists

/-- Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, we have
`N ⁻¹ S = T = (f⁻¹ (N • f(M))) ⁻¹ R`. I.e., the localization of a localization is a localization.
-/
theorem localization_localization_isLocalization [IsLocalization N T] :
    IsLocalization (localizationLocalizationSubmodule M N) T :=
  { map_units := localization_localization_map_units M N T
    surj := localization_localization_surj M N T
    eq_iff_exists := localization_localization_eq_iff_exists M N T }
#align is_localization.localization_localization_is_localization IsLocalization.localization_localization_isLocalization

include M

/-- Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, if
`N` contains all the units of `S`, then `N ⁻¹ S = T = (f⁻¹ N) ⁻¹ R`. I.e., the localization of a
localization is a localization.
-/
theorem localization_localization_isLocalization_of_has_all_units [IsLocalization N T]
    (H : ∀ x : S, IsUnit x → x ∈ N) : IsLocalization (N.comap (algebraMap R S)) T :=
  by
  convert localization_localization_is_localization M N T
  symm
  rw [sup_eq_left]
  rintro _ ⟨x, hx, rfl⟩
  exact H _ (IsLocalization.map_units _ ⟨x, hx⟩)
#align is_localization.localization_localization_is_localization_of_has_all_units IsLocalization.localization_localization_isLocalization_of_has_all_units

/--
Given a submodule `M ⊆ R` and a prime ideal `p` of `S = M⁻¹R`, with `f : R →+* S` the localization
map, then `T = Sₚ` is the localization of `R` at `f⁻¹(p)`.
-/
theorem isLocalization_isLocalization_atPrime_isLocalization (p : Ideal S) [Hp : p.IsPrime]
    [IsLocalization.AtPrime T p] : IsLocalization.AtPrime T (p.comap (algebraMap R S)) :=
  by
  apply localization_localization_is_localization_of_has_all_units M p.prime_compl T
  intro x hx hx'
  exact (Hp.1 : ¬_) (p.eq_top_of_is_unit_mem hx' hx)
#align is_localization.is_localization_is_localization_at_prime_is_localization IsLocalization.isLocalization_isLocalization_atPrime_isLocalization

instance (p : Ideal (Localization M)) [p.IsPrime] : Algebra R (Localization.AtPrime p) :=
  Localization.algebra

instance (p : Ideal (Localization M)) [p.IsPrime] :
    IsScalarTower R (Localization M) (Localization.AtPrime p) :=
  IsScalarTower.of_algebraMap_eq' rfl

instance localization_localization_atPrime_is_localization (p : Ideal (Localization M))
    [p.IsPrime] : IsLocalization.AtPrime (Localization.AtPrime p) (p.comap (algebraMap R _)) :=
  isLocalization_isLocalization_atPrime_isLocalization M _ _
#align is_localization.localization_localization_at_prime_is_localization IsLocalization.localization_localization_atPrime_is_localization

/-- Given a submodule `M ⊆ R` and a prime ideal `p` of `M⁻¹R`, with `f : R →+* S` the localization
map, then `(M⁻¹R)ₚ` is isomorphic (as an `R`-algebra) to the localization of `R` at `f⁻¹(p)`.
-/
noncomputable def localizationLocalizationAtPrimeIsoLocalization (p : Ideal (Localization M))
    [p.IsPrime] :
    Localization.AtPrime (p.comap (algebraMap R (Localization M))) ≃ₐ[R] Localization.AtPrime p :=
  IsLocalization.algEquiv (p.comap (algebraMap R (Localization M))).primeCompl _ _
#align is_localization.localization_localization_at_prime_iso_localization IsLocalization.localizationLocalizationAtPrimeIsoLocalization

end

variable (S)

/-- Given submonoids `M ≤ N` of `R`, this is the canonical algebra structure
of `M⁻¹S` acting on `N⁻¹S`. -/
noncomputable def localizationAlgebraOfSubmonoidLe (M N : Submonoid R) (h : M ≤ N)
    [IsLocalization M S] [IsLocalization N T] : Algebra S T :=
  (IsLocalization.lift fun y => (map_units T ⟨↑y, h y.Prop⟩ : _) : S →+* T).toAlgebra
#align is_localization.localization_algebra_of_submonoid_le IsLocalization.localizationAlgebraOfSubmonoidLe

/-- If `M ≤ N` are submonoids of `R`, then the natural map `M⁻¹S →+* N⁻¹S` commutes with the
localization maps -/
theorem localization_isScalarTower_of_submonoid_le (M N : Submonoid R) (h : M ≤ N)
    [IsLocalization M S] [IsLocalization N T] :
    @IsScalarTower R S T _ (localizationAlgebraOfSubmonoidLe S T M N h).toSMul _ :=
  letI := localization_algebra_of_submonoid_le S T M N h
  IsScalarTower.of_algebraMap_eq' (IsLocalization.lift_comp _).symm
#align is_localization.localization_is_scalar_tower_of_submonoid_le IsLocalization.localization_isScalarTower_of_submonoid_le

noncomputable instance (x : Ideal R) [H : x.IsPrime] [IsDomain R] :
    Algebra (Localization.AtPrime x) (Localization (nonZeroDivisors R)) :=
  localizationAlgebraOfSubmonoidLe _ _ x.primeCompl (nonZeroDivisors R)
    (by
      intro a ha
      rw [mem_nonZeroDivisors_iff_ne_zero]
      exact fun h => ha (h.symm ▸ x.zero_mem))

/-- If `M ≤ N` are submonoids of `R`, then `N⁻¹S` is also the localization of `M⁻¹S` at `N`. -/
theorem isLocalization_of_submonoid_le (M N : Submonoid R) (h : M ≤ N) [IsLocalization M S]
    [IsLocalization N T] [Algebra S T] [IsScalarTower R S T] :
    IsLocalization (N.map (algebraMap R S)) T :=
  { map_units := by
      rintro ⟨_, ⟨y, hy, rfl⟩⟩
      convert IsLocalization.map_units T ⟨y, hy⟩
      exact (IsScalarTower.algebraMap_apply _ _ _ _).symm
    surj := fun y => by
      obtain ⟨⟨x, s⟩, e⟩ := IsLocalization.surj N y
      refine' ⟨⟨algebraMap _ _ x, _, _, s.prop, rfl⟩, _⟩
      simpa [← IsScalarTower.algebraMap_apply] using e
    eq_iff_exists := fun x₁ x₂ =>
      by
      obtain ⟨⟨y₁, s₁⟩, e₁⟩ := IsLocalization.surj M x₁
      obtain ⟨⟨y₂, s₂⟩, e₂⟩ := IsLocalization.surj M x₂
      refine' Iff.trans _ (Set.exists_image_iff (algebraMap R S) N fun c => c * x₁ = c * x₂).symm
      dsimp only at e₁ e₂⊢
      suffices
        algebraMap R T (y₁ * s₂) = algebraMap R T (y₂ * s₁) ↔
          ∃ a : N, algebraMap R S (a * (y₁ * s₂)) = algebraMap R S (a * (y₂ * s₁))
        by
        have h₁ := (IsLocalization.map_units T ⟨_, h s₁.prop⟩).mul_left_inj
        have h₂ := (IsLocalization.map_units T ⟨_, h s₂.prop⟩).mul_left_inj
        simp only [IsScalarTower.algebraMap_apply R S T, Subtype.coe_mk] at h₁ h₂
        simp only [IsScalarTower.algebraMap_apply R S T, map_mul, ← e₁, ← e₂, ← mul_assoc,
          mul_right_comm _ (algebraMap R S s₂),
          mul_right_comm _ (algebraMap S T (algebraMap R S s₂)),
          (IsLocalization.map_units S s₁).mul_left_inj,
          (IsLocalization.map_units S s₂).mul_left_inj] at this
        rw [h₂, h₁] at this
        simpa only [mul_comm] using this
      simp_rw [IsLocalization.eq_iff_exists N T, IsLocalization.eq_iff_exists M S]
      constructor
      · rintro ⟨a, e⟩
        exact ⟨a, 1, by convert e using 1 <;> simp <;> ring⟩
      · rintro ⟨a, b, e⟩
        exact ⟨a * (⟨_, h b.prop⟩ : N), by convert e using 1 <;> simp <;> ring⟩ }
#align is_localization.is_localization_of_submonoid_le IsLocalization.isLocalization_of_submonoid_le

/-- If `M ≤ N` are submonoids of `R` such that `∀ x : N, ∃ m : R, m * x ∈ M`, then the
localization at `N` is equal to the localizaton of `M`. -/
theorem isLocalization_of_is_exists_mul_mem (M N : Submonoid R) [IsLocalization M S] (h : M ≤ N)
    (h' : ∀ x : N, ∃ m : R, m * x ∈ M) : IsLocalization N S :=
  { map_units := fun y => by
      obtain ⟨m, hm⟩ := h' y
      have := IsLocalization.map_units S ⟨_, hm⟩
      erw [map_mul] at this
      exact (is_unit.mul_iff.mp this).2
    surj := fun z => by
      obtain ⟨⟨y, s⟩, e⟩ := IsLocalization.surj M z
      exact ⟨⟨y, _, h s.prop⟩, e⟩
    eq_iff_exists := fun x₁ x₂ => by
      rw [IsLocalization.eq_iff_exists M]
      refine' ⟨fun ⟨x, hx⟩ => ⟨⟨_, h x.Prop⟩, hx⟩, _⟩
      rintro ⟨x, h⟩
      obtain ⟨m, hm⟩ := h' x
      refine' ⟨⟨_, hm⟩, _⟩
      simp [h, mul_assoc] }
#align is_localization.is_localization_of_is_exists_mul_mem IsLocalization.isLocalization_of_is_exists_mul_mem

end LocalizationLocalization

end IsLocalization

namespace IsFractionRing

open IsLocalization

variable (M)

theorem isFractionRing_of_isLocalization (S T : Type _) [CommRing S] [CommRing T] [Algebra R S]
    [Algebra R T] [Algebra S T] [IsScalarTower R S T] [IsLocalization M S] [IsFractionRing R T]
    (hM : M ≤ nonZeroDivisors R) : IsFractionRing S T :=
  by
  have := is_localization_of_submonoid_le S T M (nonZeroDivisors R) _
  refine' @is_localization_of_is_exists_mul_mem _ _ _ _ _ _ this _ _
  · exact map_non_zero_divisors_le M S
  · rintro ⟨x, hx⟩
    obtain ⟨⟨y, s⟩, e⟩ := IsLocalization.surj M x
    use algebraMap R S s
    rw [mul_comm, Subtype.coe_mk, e]
    refine' Set.mem_image_of_mem (algebraMap R S) _
    intro z hz
    apply IsLocalization.injective S hM
    rw [map_zero]
    apply hx
    rw [← (map_units S s).mul_left_inj, mul_assoc, e, ← map_mul, hz, map_zero,
      MulZeroClass.zero_mul]
  · exact hM
#align is_fraction_ring.is_fraction_ring_of_is_localization IsFractionRing.isFractionRing_of_isLocalization

theorem isFractionRing_of_isDomain_of_isLocalization [IsDomain R] (S T : Type _) [CommRing S]
    [CommRing T] [Algebra R S] [Algebra R T] [Algebra S T] [IsScalarTower R S T]
    [IsLocalization M S] [IsFractionRing R T] : IsFractionRing S T :=
  by
  haveI := IsFractionRing.nontrivial R T
  haveI := (algebraMap S T).domain_nontrivial
  apply is_fraction_ring_of_is_localization M S T
  intro x hx
  rw [mem_nonZeroDivisors_iff_ne_zero]
  intro hx'
  apply @zero_ne_one S
  rw [← (algebraMap R S).map_one, ← @mk'_one R _ M, @comm _ Eq, mk'_eq_zero_iff]
  exact ⟨⟨x, hx⟩, by simp [hx']⟩
#align is_fraction_ring.is_fraction_ring_of_is_domain_of_is_localization IsFractionRing.isFractionRing_of_isDomain_of_isLocalization

end IsFractionRing


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.fin.tuple
import data.real.basic
import combinatorics.pigeonhole
import algebra.order.euclidean_absolute_value

/-!
# Admissible absolute values
This file defines a structure `absolute_value.is_admissible` which we use to show the class number
of the ring of integers of a global field is finite.

## Main definitions

 * `absolute_value.is_admissible abv` states the absolute value `abv : R → ℤ`
   respects the Euclidean domain structure on `R`, and that a large enough set
   of elements of `R^n` contains a pair of elements whose remainders are
   pointwise close together.

## Main results

 * `absolute_value.abs_is_admissible` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is admissible.
 * `polynomial.card_pow_degree_is_admissible` shows `card_pow_degree`,
   mapping `p : polynomial 𝔽_q` to `q ^ degree p`, is admissible
-/

local infix ` ≺ `:50 := euclidean_domain.r

namespace absolute_value

variables {R : Type*} [euclidean_domain R]
variables (abv : absolute_value R ℤ)

/-- An absolute value `R → ℤ` is admissible if it respects the Euclidean domain
structure and a large enough set of elements in `R^n` will contain a pair of
elements whose remainders are pointwise close together. -/
structure is_admissible extends is_euclidean abv :=
(card : ℝ → ℕ)
(exists_partition' : ∀ (n : ℕ) {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0) (A : fin n → R),
                     ∃ (t : fin n → fin (card ε)),
                     ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ % b - A i₀ % b) : ℝ) < abv b • ε)

attribute [protected] is_admissible.card

namespace is_admissible

variables {abv}

/-- For all `ε > 0` and finite families `A`, we can partition the remainders of `A` mod `b`
into `abv.card ε` sets, such that all elements in each part of remainders are close together. -/
lemma exists_partition {ι : Type*} [fintype ι] {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0)
  (A : ι → R) (h : abv.is_admissible) :
  ∃ (t : ι → fin (h.card ε)),
  ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ % b - A i₀ % b) : ℝ) < abv b • ε :=
begin
  let e := fintype.equiv_fin ι,
  obtain ⟨t, ht⟩ := h.exists_partition' (fintype.card ι) hε hb (A ∘ e.symm),
  refine ⟨t ∘ e, λ i₀ i₁ h, _⟩,
  convert ht (e i₀) (e i₁) h; simp only [e.symm_apply_apply]
end

/-- Any large enough family of vectors in `R^n` has a pair of elements
whose remainders are close together, pointwise. -/
lemma exists_approx_aux (n : ℕ) (h : abv.is_admissible) :
  ∀ {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0) (A : fin (h.card ε ^ n).succ → (fin n → R)),
  ∃ (i₀ i₁), (i₀ ≠ i₁) ∧ ∀ k, (abv (A i₁ k % b - A i₀ k % b) : ℝ) < abv b • ε :=
begin
  haveI := classical.dec_eq R,
  induction n with n ih,
  { intros ε hε b hb A,
    refine ⟨0, 1, _, _⟩,
    { simp },
    rintros ⟨i, ⟨⟩⟩ },
  intros ε hε b hb A,
  set M := h.card ε with hM,
  -- By the "nicer" pigeonhole principle, we can find a collection `s`
  -- of more than `M^n` remainders where the first components lie close together:
  obtain ⟨s, s_inj, hs⟩ : ∃ s : fin (M ^ n).succ → fin (M ^ n.succ).succ,
    function.injective s ∧
    ∀ i₀ i₁, (abv (A (s i₁) 0 % b - A (s i₀) 0 % b) : ℝ) < abv b • ε,
  { -- We can partition the `A`s into `M` subsets where
    -- the first components lie close together:
    obtain ⟨t, ht⟩ : ∃ (t : fin (M ^ n.succ).succ → fin M),
      ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ 0 % b - A i₀ 0 % b) : ℝ) < abv b • ε :=
      h.exists_partition hε hb (λ x, A x 0),
    -- Since the `M` subsets contain more than `M * M^n` elements total,
    -- there must be a subset that contains more than `M^n` elements.
    obtain ⟨s, hs⟩ := @fintype.exists_lt_card_fiber_of_mul_lt_card _ _ _ _ _ t (M ^ n)
      (by simpa only [fintype.card_fin, pow_succ] using nat.lt_succ_self (M ^ n.succ) ),
    refine ⟨λ i, (finset.univ.filter (λ x, t x = s)).to_list.nth_le i _, _, λ i₀ i₁, ht _ _ _⟩,
    { refine i.2.trans_le _, rwa finset.length_to_list },
    { intros i j h, ext, exact list.nodup_iff_nth_le_inj.mp (finset.nodup_to_list _) _ _ _ _ h },
    have : ∀ i h, (finset.univ.filter (λ x, t x = s)).to_list.nth_le i h ∈
      finset.univ.filter (λ x, t x = s),
    { intros i h, exact (finset.mem_to_list _).mp (list.nth_le_mem _ _ _) },
    obtain ⟨_, h₀⟩ := finset.mem_filter.mp (this i₀ _),
    obtain ⟨_, h₁⟩ := finset.mem_filter.mp (this i₁ _),
    exact h₀.trans h₁.symm },
  -- Since `s` is large enough, there are two elements of `A ∘ s`
  -- where the second components lie close together.
  obtain ⟨k₀, k₁, hk, h⟩ := ih hε hb (λ x, fin.tail (A (s x))),
  refine ⟨s k₀, s k₁, λ h, hk (s_inj h), λ i, fin.cases _ (λ i, _) i⟩,
  { exact hs k₀ k₁ },
  { exact h i },
end

/-- Any large enough family of vectors in `R^ι` has a pair of elements
whose remainders are close together, pointwise. -/
lemma exists_approx {ι : Type*} [fintype ι] {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0)
  (h : abv.is_admissible)
  (A : fin (h.card ε ^ fintype.card ι).succ → ι → R) :
  ∃ (i₀ i₁), (i₀ ≠ i₁) ∧ ∀ k, (abv (A i₁ k % b - A i₀ k % b) : ℝ) < abv b • ε :=
begin
  let e := fintype.equiv_fin ι,
  obtain ⟨i₀, i₁, ne, h⟩ := h.exists_approx_aux (fintype.card ι) hε hb (λ x y, A x (e.symm y)),
  refine ⟨i₀, i₁, ne, λ k, _⟩,
  convert h (e k); simp only [e.symm_apply_apply]
end

end is_admissible

end absolute_value


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

Binder elimination
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.default
import Mathlib.PostPort

universes u v

namespace Mathlib

namespace old_conv

/- congr should forward data! -/

end old_conv

/- Binder elimination:

We assume a binder `B : p → Π (α : Sort u), (α → t) → t`, where `t` is a type depending on `p`.
Examples:
  ∃: there is no `p` and `t` is `Prop`.
  ⨅, ⨆: here p is `β` and `[complete_lattice β]`, `p` is `β`

Problem: ∀x, _ should be a binder, but is not a constant!

Provide a mechanism to rewrite:

  B (x : α) ..x.. (h : x = t), p x  =  B ..x/t.., p t

Here ..x.. are binders, maybe also some constants which provide commutativity rules with `B`.

-/

theorem exists_elim_eq_left {α : Sort u} (a : α) (p : (a' : α) → a' = a → Prop) :
    (∃ (a' : α), ∃ (h : a' = a), p a' h) ↔ p a rfl :=
  sorry

theorem exists_elim_eq_right {α : Sort u} (a : α) (p : (a' : α) → a = a' → Prop) :
    (∃ (a' : α), ∃ (h : a = a'), p a' h) ↔ p a rfl :=
  sorry

theorem forall_comm {α : Sort u} {β : Sort v} (p : α → β → Prop) :
    (∀ (a : α) (b : β), p a b) ↔ ∀ (b : β) (a : α), p a b :=
  { mp := fun (h : ∀ (a : α) (b : β), p a b) (b : β) (a : α) => h a b,
    mpr := fun (h : ∀ (b : β) (a : α), p a b) (b : α) (a : β) => h a b }

theorem forall_elim_eq_left {α : Sort u} (a : α) (p : (a' : α) → a' = a → Prop) :
    (∀ (a' : α) (h : a' = a), p a' h) ↔ p a rfl :=
  sorry

theorem forall_elim_eq_right {α : Sort u} (a : α) (p : (a' : α) → a = a' → Prop) :
    (∀ (a' : α) (h : a = a'), p a' h) ↔ p a rfl :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import algebra.order.archimedean
import order.filter.at_top_bot

/-!
# `at_top` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

variables {α R : Type*}

open filter set

lemma tendsto_coe_nat_at_top_iff [ordered_semiring R] [nontrivial R] [archimedean R]
  {f : α → ℕ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_at_top [ordered_semiring R] [archimedean R] :
  tendsto (coe : ℕ → R) at_top at_top :=
nat.mono_cast.tendsto_at_top_at_top exists_nat_ge

lemma tendsto_coe_int_at_top_iff [ordered_ring R] [nontrivial R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, int.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨(n:ℤ), hn⟩

lemma tendsto_coe_int_at_top_at_top [ordered_ring R] [archimedean R] :
  tendsto (coe : ℤ → R) at_top at_top :=
int.cast_mono.tendsto_at_top_at_top $ λ b,
  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, hn⟩

lemma tendsto_coe_rat_at_top_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, rat.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨(n:ℚ), by assumption_mod_cast⟩

lemma at_top_countable_basis_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).has_countable_basis (λ n : ℕ, true) (λ n, Ici n) :=
{ countable := countable_encodable _,
  to_has_basis := at_top_basis.to_has_basis
    (λ x hx, let ⟨n, hn⟩ := exists_nat_ge x in ⟨n, trivial, Ici_subset_Ici.2 hn⟩)
    (λ n hn, ⟨n, trivial, subset.rfl⟩) }

lemma at_bot_countable_basis_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).has_countable_basis (λ m : ℤ, true) (λ m, Iic m) :=
{ countable := countable_encodable _,
  to_has_basis := at_bot_basis.to_has_basis
    (λ x hx, let ⟨m, hm⟩ := exists_int_lt x in ⟨m, trivial, Iic_subset_Iic.2 hm.le⟩)
    (λ m hm, ⟨m, trivial, subset.rfl⟩) }

@[priority 100]
instance at_top_countably_generated_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).is_countably_generated :=
at_top_countable_basis_of_archimedean.is_countably_generated

@[priority 100]
instance at_bot_countably_generated_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).is_countably_generated :=
at_bot_countable_basis_of_archimedean.is_countably_generated

variables [linear_ordered_semiring R] [archimedean R]
variables {l : filter α} {f : α → R} {r : R}

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
lemma filter.tendsto.const_mul_at_top' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, r * f x) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  rw nsmul_eq_mul' at hn,
  filter_upwards [tendsto_at_top.1 hf (n * max b 0)],
  assume x hx,
  calc b ≤ 1 * max b 0 : by { rw [one_mul], exact le_max_left _ _ }
  ... ≤ (r * n) * max b 0 : mul_le_mul_of_nonneg_right hn (le_max_right _ _)
  ... = r * (n * max b 0) : by rw [mul_assoc]
  ... ≤ r * f x : mul_le_mul_of_nonneg_left hx (le_of_lt hr)
end

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
lemma filter.tendsto.at_top_mul_const' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, f x * r) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  have hn' : 1 ≤ (n : R) * r, by rwa nsmul_eq_mul at hn,
  filter_upwards [tendsto_at_top.1 hf (max b 0 * n)],
  assume x hx,
  calc b ≤ max b 0 * 1 : by { rw [mul_one], exact le_max_left _ _ }
  ... ≤ max b 0 * (n * r) : mul_le_mul_of_nonneg_left hn' (le_max_right _ _)
  ... = (max b 0 * n) * r : by rw [mul_assoc]
  ... ≤ f x * r : mul_le_mul_of_nonneg_right hx (le_of_lt hr)
end


/-
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 for_mathlib.dold_kan.projections
import category_theory.idempotents.functor_categories
import category_theory.idempotents.functor_extension

/-!

# Construction of the projection `P_infty` for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

In this file, we construct the projection `P_infty : K[X] ⟶ K[X]` by passing
to the limit the projections `P q` defined in `projections.lean`. This
projection is a critical tool in this formalisation of the Dold-Kan correspondence,
because in the case of abelian categories, `P_infty` corresponds to the
projection on the normalized Moore subcomplex, with kernel the degenerate subcomplex.
(See `equivalence.lean` for the general strategy of proof.)

-/

open category_theory
open category_theory.category
open category_theory.preadditive
open category_theory.simplicial_object
open category_theory.idempotents
open opposite
open_locale simplicial dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] {X : simplicial_object C}

lemma P_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
  ((P (q+1)).f n : X _[n] ⟶ _ ) = (P q).f n :=
begin
  cases n,
  { simp only [P_f_0_eq], },
  { unfold P,
    simp only [add_right_eq_self, comp_add, homological_complex.comp_f,
      homological_complex.add_f_apply, comp_id],
    exact (higher_faces_vanish.of_P q n).comp_Hσ_eq_zero
      (nat.succ_le_iff.mp hqn), },
end

lemma Q_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
  ((Q (q+1)).f n : X _[n] ⟶ _ ) = (Q q).f n :=
by simp only [Q, homological_complex.sub_f_apply, P_is_eventually_constant hqn]

/-- The endomorphism `P_infty : K[X] ⟶ K[X]` obtained from the `P q` by passing to the limit. -/
def P_infty : K[X] ⟶ K[X] := chain_complex.of_hom _ _ _ _ _ _
  (λ n, ((P n).f n : X _[n] ⟶ _ ))
  (λ n, by simpa only [← P_is_eventually_constant (show n ≤ n, by refl),
    alternating_face_map_complex.obj_d_eq] using (P (n+1)).comm (n+1) n)

/-- The endomorphism `Q_infty : K[X] ⟶ K[X]` obtained from the `Q q` by passing to the limit. -/
def Q_infty : K[X] ⟶ K[X] := 𝟙 _ - P_infty

@[simp]
lemma P_infty_f_0 : (P_infty.f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ := rfl

lemma P_infty_f (n : ℕ) : (P_infty.f n : X _[n] ⟶  X _[n] ) = (P n).f n := rfl

@[simp]
lemma Q_infty_f_0 : (Q_infty.f 0 : X _[0] ⟶ X _[0]) = 0 :=
by { dsimp [Q_infty], simp only [sub_self], }

lemma Q_infty_f (n : ℕ) : (Q_infty.f n : X _[n] ⟶  X _[n] ) = (Q n).f n := rfl

@[simp, reassoc]
lemma P_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) :
  f.app (op [n]) ≫ P_infty.f n = P_infty.f n ≫ f.app (op [n]) :=
P_f_naturality n n f

@[simp, reassoc]
lemma Q_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) :
  f.app (op [n]) ≫ Q_infty.f n = Q_infty.f n ≫ f.app (op [n]) :=
Q_f_naturality n n f

@[simp, reassoc]
lemma P_infty_f_idem (n : ℕ) :
  (P_infty.f n : X _[n] ⟶ _) ≫ (P_infty.f n) = P_infty.f n :=
by simp only [P_infty_f, P_f_idem]

@[simp, reassoc]
lemma P_infty_idem : (P_infty : K[X] ⟶ _) ≫ P_infty = P_infty :=
by { ext n, exact P_infty_f_idem n, }

@[simp, reassoc]
lemma Q_infty_f_idem (n : ℕ) :
  (Q_infty.f n : X _[n] ⟶ _) ≫ (Q_infty.f n) = Q_infty.f n :=
Q_f_idem _ _

@[simp, reassoc]
lemma Q_infty_idem : (Q_infty : K[X] ⟶ _) ≫ Q_infty = Q_infty :=
by { ext n, exact Q_infty_f_idem n, }

@[simp, reassoc]
lemma P_infty_f_comp_Q_infty_f (n : ℕ) :
  (P_infty.f n : X _[n] ⟶ _) ≫ Q_infty.f n = 0 :=
begin
  dsimp only [Q_infty],
  simp only [homological_complex.sub_f_apply, homological_complex.id_f, comp_sub, comp_id,
    P_infty_f_idem, sub_self],
end

@[simp, reassoc]
lemma P_infty_comp_Q_infty :
  (P_infty : K[X] ⟶ _) ≫ Q_infty = 0 :=
by { ext n, apply P_infty_f_comp_Q_infty_f, }

@[simp, reassoc]
lemma Q_infty_f_comp_P_infty_f (n : ℕ) :
  (Q_infty.f n : X _[n] ⟶ _) ≫ P_infty.f n = 0 :=
begin
  dsimp only [Q_infty],
  simp only [homological_complex.sub_f_apply, homological_complex.id_f, sub_comp, id_comp,
    P_infty_f_idem, sub_self],
end

@[simp, reassoc]
lemma Q_infty_comp_P_infty :
  (Q_infty : K[X] ⟶ _) ≫ P_infty = 0 :=
by { ext n, apply Q_infty_f_comp_P_infty_f, }

@[simp]
lemma P_infty_add_Q_infty :
  (P_infty : K[X] ⟶ _) + Q_infty = 𝟙 _ :=
by { dsimp only [Q_infty], simp only [add_sub_cancel'_right], }

lemma P_infty_f_add_Q_infty_f (n : ℕ) :
  (P_infty.f n : X _[n] ⟶ _ ) + Q_infty.f n = 𝟙 _ :=
homological_complex.congr_hom (P_infty_add_Q_infty) n

variable (C)

/-- `P_infty` induces a natural transformation, i.e. an endomorphism of
the functor `alternating_face_map_complex C`. -/
@[simps]
def nat_trans_P_infty :
  alternating_face_map_complex C ⟶ alternating_face_map_complex C :=
{ app := λ _, P_infty,
  naturality' := λ X Y f, by { ext n, exact P_infty_f_naturality n f, }, }

/-- The natural transformation in each degree that is induced by `nat_trans_P_infty`. -/
@[simps]
def nat_trans_P_infty_f (n : ℕ) :=
nat_trans_P_infty C ◫ 𝟙 (homological_complex.eval _ _ n)

variable {C}

@[simp]
lemma map_P_infty_f {D : Type*} [category D] [preadditive D]
  (G : C ⥤ D) [G.additive] (X : simplicial_object C) (n : ℕ) :
  (P_infty : K[((whiskering C D).obj G).obj X] ⟶ _).f n =
  G.map ((P_infty : alternating_face_map_complex.obj X ⟶ _).f n) :=
by simp only [P_infty_f, map_P]

/-- Given an object `Y : karoubi (simplicial_object C)`, this lemma
computes `P_infty` for the associated object in `simplicial_object (karoubi C)`
in terms of `P_infty` for `Y.X : simplicial_object C` and `Y.p`. -/
lemma karoubi_P_infty_f {Y : karoubi (simplicial_object C)} (n : ℕ) :
  ((P_infty : K[(karoubi_functor_category_embedding _ _).obj Y] ⟶ _).f n).f =
    Y.p.app (op [n]) ≫ (P_infty : K[Y.X] ⟶ _).f n :=
begin
  -- We introduce P_infty endomorphisms P₁, P₂, P₃, P₄ on various objects Y₁, Y₂, Y₃, Y₄.
  let Y₁ := (karoubi_functor_category_embedding _ _).obj Y,
  let Y₂ := Y.X,
  let Y₃ := (((whiskering _ _).obj (to_karoubi C)).obj Y.X),
  let Y₄ := (karoubi_functor_category_embedding _ _).obj ((to_karoubi _).obj Y.X),
  let P₁ : K[Y₁] ⟶ _ := P_infty,
  let P₂ : K[Y₂] ⟶ _ := P_infty,
  let P₃ : K[Y₃] ⟶ _ := P_infty,
  let P₄ : K[Y₄] ⟶ _ := P_infty,
  -- The statement of lemma relates P₁ and P₂.
  change (P₁.f n).f = Y.p.app (op [n]) ≫ P₂.f n,
  -- The proof proceeds by obtaining relations h₃₂, h₄₃, h₁₄.
  have h₃₂ : (P₃.f n).f = P₂.f n := karoubi.hom_ext.mp (map_P_infty_f (to_karoubi C) Y₂ n),
  have h₄₃ : P₄.f n = P₃.f n,
  { have h := functor.congr_obj (to_karoubi_comp_karoubi_functor_category_embedding _ _) Y₂,
    simp only [← nat_trans_P_infty_f_app],
    congr', },
  let τ₁ := 𝟙 (karoubi_functor_category_embedding (simplex_categoryᵒᵖ) C),
  let τ₂ := nat_trans_P_infty_f (karoubi C) n,
  let τ := τ₁ ◫ τ₂,
  have h₁₄ := idempotents.nat_trans_eq τ Y,
  dsimp [τ, τ₁, τ₂, nat_trans_P_infty_f] at h₁₄,
  rw [id_comp, id_comp, comp_id, comp_id] at h₁₄,
  /- We use the three equalities h₃₂, h₄₃, h₁₄. -/
  rw [← h₃₂, ← h₄₃, h₁₄],
  simp only [karoubi_functor_category_embedding.map_app_f, karoubi.decomp_id_p_f,
    karoubi.decomp_id_i_f, karoubi.comp_f],
  let π : Y₄ ⟶ Y₄ := (to_karoubi _ ⋙ karoubi_functor_category_embedding _ _).map Y.p,
  have eq := karoubi.hom_ext.mp (P_infty_f_naturality n π),
  simp only [karoubi.comp_f] at eq,
  dsimp [π] at eq,
  rw [← eq, reassoc_of (app_idem Y (op [n]))],
end

end dold_kan

end algebraic_topology


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import model_theory.quotients
import order.filter.germ
import order.filter.ultrafilter

/-! # Ultraproducts and Łoś's Theorem

## Main Definitions
* `first_order.language.ultraproduct.Structure` is the ultraproduct structure on `filter.product`.

## Main Results
* Łoś's Theorem: `first_order.language.ultraproduct.sentence_realize`. An ultraproduct models a
sentence `φ` if and only if the set of structures in the product that model `φ` is in the
ultrafilter.

## Tags
ultraproduct, Los's theorem

-/

universes u v
variables {α : Type*} (M : α → Type*) (u : ultrafilter α)

open_locale first_order filter

open filter

namespace first_order
namespace language

open Structure

variables {L : language.{u v}} [Π a, L.Structure (M a)]

namespace ultraproduct

instance setoid_prestructure : L.prestructure ((u : filter α).product_setoid M) :=
{ to_structure := { fun_map := λ n f x a, fun_map f (λ i, x i a),
             rel_map := λ n r x, ∀ᶠ (a : α) in u, rel_map r (λ i, x i a) },
  fun_equiv := λ n f x y xy, begin
    refine mem_of_superset (Inter_mem.2 xy) (λ a ha, _),
    simp only [set.mem_Inter, set.mem_set_of_eq] at ha,
    simp only [set.mem_set_of_eq, ha],
  end,
  rel_equiv := λ n r x y xy, begin
    rw ← iff_eq_eq,
    refine ⟨λ hx, _, λ hy, _⟩,
    { refine mem_of_superset (inter_mem hx (Inter_mem.2 xy)) _,
      rintro a ⟨ha1, ha2⟩,
      simp only [set.mem_Inter, set.mem_set_of_eq] at *,
      rw ← funext ha2,
      exact ha1 },
    { refine mem_of_superset (inter_mem hy (Inter_mem.2 xy)) _,
      rintro a ⟨ha1, ha2⟩,
      simp only [set.mem_Inter, set.mem_set_of_eq] at *,
      rw funext ha2,
      exact ha1 },
  end,
  .. (u : filter α).product_setoid M }

variables {M} {u}

instance Structure : L.Structure ((u : filter α).product M) := language.quotient_structure

lemma fun_map_cast {n : ℕ} (f : L.functions n) (x : fin n → (Π a, M a)) :
  fun_map f (λ i, ((x i) : (u : filter α).product M)) = λ a, fun_map f (λ i, x i a) :=
by apply fun_map_quotient_mk

lemma term_realize_cast {β : Type*} (x : β → (Π a, M a)) (t : L.term β) :
  t.realize (λ i, ((x i) : (u : filter α).product M)) = λ a, t.realize (λ i, x i a) :=
begin
  convert @term.realize_quotient_mk L _  ((u : filter α).product_setoid M)
    (ultraproduct.setoid_prestructure M u) _ t x,
  ext a,
  induction t,
  { refl },
  { simp only [term.realize, t_ih],
    refl }
end

variables [Π a : α, nonempty (M a)]

theorem bounded_formula_realize_cast {β : Type*} {n : ℕ} (φ : L.bounded_formula β n)
  (x : β → (Π a, M a)) (v : fin n → (Π a, M a)) :
  φ.realize (λ (i : β), ((x i) : (u : filter α).product M)) (λ i, (v i)) ↔
    ∀ᶠ (a : α) in u, φ.realize (λ (i : β), x i a) (λ i, v i a) :=
begin
  letI := ((u : filter α).product_setoid M),
  induction φ with _ _ _ _ _ _ _ _ m _ _ ih ih' k φ ih,
  { simp only [bounded_formula.realize, eventually_const], },
  { have h2 : ∀ a : α, sum.elim (λ (i : β), x i a) (λ i, v i a) = λ i, sum.elim x v i a :=
      λ a, funext (λ i, sum.cases_on i (λ i, rfl) (λ i, rfl)),
    simp only [bounded_formula.realize, (sum.comp_elim coe x v).symm, h2, term_realize_cast],
    exact quotient.eq' },
  { have h2 : ∀ a : α, sum.elim (λ (i : β), x i a) (λ i, v i a) = λ i, sum.elim x v i a :=
      λ a, funext (λ i, sum.cases_on i (λ i, rfl) (λ i, rfl)),
    simp only [bounded_formula.realize, (sum.comp_elim coe x v).symm, term_realize_cast, h2],
    exact rel_map_quotient_mk _ _ },
  { simp only [bounded_formula.realize, ih v, ih' v],
    rw ultrafilter.eventually_imp },
  { simp only [bounded_formula.realize],
    transitivity (∀ (m : Π (a : α), M a), φ.realize (λ (i : β), (x i : (u : filter α).product M))
      (fin.snoc (coe ∘ v) (↑m : (u : filter α).product M))),
    { exact forall_quotient_iff },
    have h' : ∀ (m : Π a, M a) (a : α), (λ (i : fin (k + 1)), (fin.snoc v m : _ → Π a, M a) i a) =
      fin.snoc (λ (i : fin k), v i a) (m a),
    { refine λ m a, funext (fin.reverse_induction _ (λ i hi, _)),
      { simp only [fin.snoc_last] },
      { simp only [fin.snoc_cast_succ] } },
    simp only [← fin.comp_snoc, ih, h'],
    refine ⟨λ h, _, λ h m, _⟩,
    { contrapose! h,
      simp_rw [← ultrafilter.eventually_not, not_forall] at h,
      refine ⟨λ a : α, classical.epsilon (λ m : M a, ¬ φ.realize (λ i, x i a)
        (fin.snoc (λ i, v i a) m)), _⟩,
      rw [← ultrafilter.eventually_not],
      exact filter.mem_of_superset h (λ a ha, classical.epsilon_spec ha) },
    { rw filter.eventually_iff at *,
      exact filter.mem_of_superset h (λ a ha, ha (m a)) } }
end

theorem realize_formula_cast {β : Type*} (φ : L.formula β) (x : β → (Π a, M a)) :
  φ.realize (λ i, ((x i) : (u : filter α).product M)) ↔
    ∀ᶠ (a : α) in u, φ.realize (λ i, (x i a)) :=
begin
  simp_rw [formula.realize, ← bounded_formula_realize_cast φ x, iff_eq_eq],
  exact congr rfl (subsingleton.elim _ _),
end

/-- Łoś's Theorem : A sentence is true in an ultraproduct if and only if the set of structures it is
  true in is in the ultrafilter. -/
theorem sentence_realize (φ : L.sentence) :
  ((u : filter α).product M) ⊨ φ ↔ ∀ᶠ (a : α) in u, (M a) ⊨ φ :=
begin
  simp_rw [sentence.realize, ← realize_formula_cast φ, iff_eq_eq],
  exact congr rfl (subsingleton.elim _ _),
end

instance : nonempty ((u : filter α).product M) :=
begin
  letI : Π a, inhabited (M a) := λ _, classical.inhabited_of_nonempty',
  exact nonempty_of_inhabited,
end

end ultraproduct

end language
end first_order


import tactic data.set
import prop.language

namespace prop

-- proof with context (Γ)
inductive Proof (Ax : set Formula) : set Formula → set Formula
  | in_axioms : ∀ {Γ φ} {h : φ ∈ Ax}, Proof Γ φ
  | in_context : ∀ {Γ φ} {h : φ ∈ Γ}, Proof Γ φ
  | mp : ∀ {Γ φ ψ}, Proof Γ (φ →' ψ) → Proof Γ φ → Proof Γ ψ

notation Γ `⊢[` Ax `]` φ : 25 := Proof Ax Γ φ
notation `⊢[` Ax `]` φ : 25 := Proof Ax ∅ φ

open Proof

def inconsistent (Ax Γ) : Prop
  := Γ ⊢[Ax] ⊥'
def consistent (Ax Γ): Prop
  := ¬(inconsistent Ax Γ)

lemma proof_mp_ctx (A : set Formula) (Γ : set Formula) (φ ψ : Formula)
  : (φ ∈ Γ) → ((φ →' ψ) ∈ Γ) → (Γ ⊢[A] ψ) :=
begin
  intros h₁ h₂,
  have h₃: (Γ ⊢[A] (φ →' ψ)) := @Proof.in_context _ _ _ h₂,
  have h₄: (Γ ⊢[A] φ) := @Proof.in_context _ _ _ h₁,
  have h₅: (Γ ⊢[A] ψ) := @Proof.mp _ _ _ _ h₃ h₄,
  assumption,
end

lemma proof_subset (Ax : set Formula) (Γ Γ' : set Formula) (φ : Formula)
  : Γ ⊆ Γ' → (Γ ⊢[Ax] φ) → (Γ' ⊢[Ax] φ) :=
begin
  intros h₁ h₂,
  induction h₂,

  case in_axioms :{
    apply Proof.in_axioms,
    assumption,
  },

  case in_context :{
    apply Proof.in_context,
    tauto,
  },

  case mp : _ _ _ _ _ ih₁ ih₂ {
    have h₃ := ih₁ h₁,
    have h₄ := ih₂ h₁,
    exact @Proof.mp _ _ _ _ h₃ h₄,
  },
end

lemma lift_subset (AX₁ AX₂ : set Formula) (Γ : set Formula) (φ : Formula)
  : AX₁ ⊆ AX₂ → (Γ ⊢[AX₁] φ) → (Γ ⊢[AX₂] φ) :=
begin
  intros hax h₁,
  induction h₁,

  case in_axioms :{
    apply Proof.in_axioms,
    apply hax,
    assumption,
  },

  case in_context :{
    apply Proof.in_context,
    tauto,
  },

  case mp {
    apply Proof.mp,
    assumption,
    assumption,
  },
end

-- Łukasiewicz
inductive AxiomL : set Formula
  | P1 : ∀ {φ ψ}, AxiomL $ φ →' (ψ →' φ)
  | P2 : ∀ {φ ψ χ}, AxiomL $ (φ →' (ψ →' χ)) →' ((φ →' ψ) →' (φ →' χ))
  | P3 : ∀ {φ ψ}, AxiomL $ (¬'φ →' ¬'ψ) →' (φ →' ψ)

notation Γ `⊢ₗ` φ : 25 := Γ ⊢[AxiomL] φ
notation `⊢ₗ` φ : 25 := ∅ ⊢ₗ φ

open AxiomL

def consistentL := consistent AxiomL
def inconsistentL := inconsistent AxiomL

lemma reflexive_L : ∀ {Γ φ}, Γ ⊢ₗ (φ →' φ) :=
begin
  intros Γ φ,
  have h₁ : (Γ ⊢ₗ (φ →' ((φ →' φ) →' φ)) →' ((φ →' (φ →' φ)) →' (φ →' φ))),
    apply in_axioms,
    apply P2,
  have h₂ : (Γ ⊢ₗ (φ →' (φ →' φ) →' φ)),
    apply in_axioms,
    apply P1,
  have h₃ : (Γ ⊢ₗ φ →' (φ →' φ)),
    apply in_axioms,
    apply P1,

  have h₄ := @mp _ _ _ _ h₁ h₂,
  have h₅ := @mp _ _ _ _ h₄ h₃,
  assumption,
end

-- lemma append_L
--   : ∀ {Γ φ ψ}, (Γ ⊢ₗ φ) → (Γ ⊢ₗ (ψ →' φ)) :=
-- begin
--   intros Γ φ ψ h,
--   have h₁ : (Γ ⊢ₗ ψ →' (φ →' ψ)),
--     apply in_axioms,
--     sorry,
--
--   -- exact h₁,
--   exact @mp AxiomL Γ φ ψ ,
-- end
lemma append_L
  : ∀ {Γ φ ψ}, (Γ ⊢ₗ ψ) → (Γ ⊢ₗ φ →' ψ) := sorry

theorem deduction_L
  : ∀ {Γ φ ψ}, (Γ ∪ {φ} ⊢ₗ ψ) ↔ (Γ ⊢ₗ (φ →' ψ)) :=
begin
  intros Γ φ ψ,
  split,

  generalize eq : Γ ∪ {φ} = Γ',
  intro h,
  induction h,

  case in_axioms :{
    apply in_axioms,
    sorry,
  },

  case in_context : _ _ ctx {
    rw [←eq] at ctx,
    cases ctx,
    case or.inl :{
      sorry,
    },
    case or.inr :{
      apply append_L,
      apply in_context,
      sorry,
    },
  },

  case mp: _ φ' ψ' ih₁ ih₂ {
    sorry
  },

  sorry,
end

example (φ ψ) : (⊢ₗ φ →' ψ) → ({φ} ⊢ₗ ψ) :=
begin
  intro h,
  have h₃ := (iff.elim_right (@deduction_L ∅ φ ψ)) h,
  rw set.empty_union at h₃,
  exact h₃,
end

example (φ ψ) : (⊢ₗ ¬'φ →' (φ →' ψ)) → ({φ, ¬'φ} ⊢ₗ ψ) :=
begin
  intro h,
  have h₁ := (iff.elim_right (@deduction_L ∅ (¬'φ) (φ →' ψ))) h,
  rw set.empty_union at h₁,
  have h₂ := (iff.elim_right (@deduction_L {¬'φ} φ ψ)),
  have h₃ := h₂ h₁,
  rw set.union_def at h₃,
  sorry,
end

lemma explosion_L (Γ φ) : (Γ ⊢ₗ ⊥') → (Γ ⊢ₗ φ) :=
begin
  intro h,
  have h₁ : (Γ ⊢ₗ ¬'φ) := @append_L _ _ _ h,
  sorry
end

lemma explosion_L' (Γ φ ψ) : (Γ ⊢ₗ φ) → (Γ ⊢ₗ ¬'φ) → (Γ ⊢ₗ ψ) :=
begin
  intros ht hf,
  have h₁ : (Γ ⊢ₗ ⊥') := @mp _ _ _ _ hf ht,
  exact explosion_L _ _ h₁,
end

lemma lemma_2_9 (Γ φ) : (inconsistentL Γ) → (Γ ⊢ₗ φ) :=
begin
  intro hi,
  exact explosion_L Γ φ hi,
end

lemma lemma_2_10 (Γ φ) : (Γ ⊢ₗ φ) → (Γ ⊢ₗ ¬'φ) → inconsistentL Γ :=
begin
  intros ht hf,
  exact explosion_L' _ _ ⊥' ht hf,
end

lemma lemma_2_10' (Γ φ) : consistentL Γ → (Γ ⊢ₗ φ) ∨ (Γ ⊢ₗ ¬'φ) :=
begin
  intro hc,
  sorry,
end

lemma lemma_2_11 (Γ φ) : (inconsistentL (Γ ∪ {φ})) ↔ (Γ ⊢ₗ ¬'φ) :=
begin
  split,
  intro h,
  sorry,

  intro h,
  apply iff.elim_right (@deduction_L Γ φ ⊥'),
  assumption,
end

lemma lemma_2_12 (Γ φ) :
consistentL Γ → (consistentL (Γ ∪ {φ})) ∨ (consistentL (Γ ∪ {¬'φ})) :=
begin
  intro hi,
  have h₁ : (Γ ⊢ₗ φ) ∨ (Γ ⊢ₗ ¬'φ) := @lemma_2_10' _ _ hi,
  sorry
end

end prop


namespace prop_06

variables A B : Prop

theorem prop_6 : (A -> B) -> (A -> (A /\ B)) :=
assume h1: A → B,
assume h2: A,
have h3: B, from h1 h2,
show A ∧ B, from and.intro h2 h3

-- end namespace
end prop_06


import tag009I -- presheaf of types on basis
import tag009H -- stalk on basis
import tag009J -- sheaf of types on basis
import data.set.function

definition sheaf_on_basis.canonical_map {X : Type*} [T : topological_space X] {B : set (set X)}
  {HB : topological_space.is_topological_basis B} (FB : presheaf_of_types_on_basis HB)
  (HF : is_sheaf_of_types_on_basis FB) {U : set X} (BU : U ∈ B) :
  FB.F BU → Π x : X, x ∈ U → presheaf_on_basis_stalk FB x := λ s x Hx,⟦{U := U, BU := BU, Hx := Hx, s := s}⟧

#exit
theorem lemma_condition_star_sections {X : Type*} [T : topological_space X] {B : set (set X)}
  {HB : topological_space.is_topological_basis B} (FB : presheaf_of_types_on_basis HB)
  (HF : is_sheaf_of_types_on_basis FB) {U : set X} (BU : U ∈ B)
   : function.injective (sheaf_on_basis.canonical_map FB HF BU)
   ∧ set.image (sheaf_on_basis.canonical_map FB HF BU) set.univ =
     { s : Π x : X, x ∈ U → presheaf_on_basis_stalk FB x |
       ∀ x : X, x ∈ U → (∃ (V : set X) (BV : V ∈ B) (Hx : x ∈ V) (sigma : FB.F BV),
         ∀ (y : X) (Hy : y ∈ U) (Hy' : y ∈ V), s y Hy = ⟦{U := V, BU := BV, Hx := Hy', s := sigma}⟧)} :=
sorry


/-
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
-/
import algebra.module tactic.ring linear_algebra.quotient_module

universes u v
variables {α : Type u} {β : Type v} [comm_ring α] {a b : α}
open set function

local attribute [instance] classical.prop_decidable

class is_ideal {α : Type u} [comm_ring α] (S : set α) extends is_submodule S : Prop

namespace is_ideal

protected lemma zero (S : set α) [is_ideal S] : (0 : α) ∈ S := is_submodule.zero_ α S

protected lemma add {S : set α} [is_ideal S] : a ∈ S → b ∈ S → a + b ∈ S := is_submodule.add_ α

lemma neg_iff {S : set α} [is_ideal S] : a ∈ S ↔ -a ∈ S := ⟨is_submodule.neg, λ h, neg_neg a ▸ is_submodule.neg h⟩

protected lemma sub {S : set α} [is_ideal S] : a ∈ S → b ∈ S → a - b ∈ S := is_submodule.sub

lemma mul_left {S : set α} [is_ideal S] : b ∈ S → a * b ∈ S := @is_submodule.smul α α _ _ _ _ a _

lemma mul_right {S : set α} [is_ideal S] : a ∈ S → a * b ∈ S := mul_comm b a ▸ mul_left

def trivial (α : Type*) [comm_ring α] : set α := {0}

@[simp] lemma mem_trivial : a ∈ trivial α ↔ a = 0 := by simp [trivial]

instance : is_ideal (trivial α) := by refine {..}; simp [trivial] {contextual := tt}

instance univ : is_ideal (@univ α) := {}

instance span (S : set α) : is_ideal (span S) := {}

end is_ideal

class is_proper_ideal {α : Type u} [comm_ring α] (S : set α) extends is_ideal S : Prop :=
(ne_univ : S ≠ set.univ)

lemma is_proper_ideal_iff_one_not_mem {S : set α} [hS : is_ideal S] :
  is_proper_ideal S ↔ (1 : α) ∉ S :=
⟨λ h h1, by exactI is_proper_ideal.ne_univ S
  (eq_univ_iff_forall.2 (λ a, mul_one a ▸ is_ideal.mul_left h1)),
λ h, {ne_univ := mt eq_univ_iff_forall.1 (λ ha, h (ha _)), ..hS}⟩

class is_prime_ideal {α : Type u} [comm_ring α] (S : set α) extends is_proper_ideal S : Prop :=
(mem_or_mem_of_mul_mem : ∀ {x y : α}, x * y ∈ S → x ∈ S ∨ y ∈ S)

theorem mem_or_mem_of_mul_eq_zero {α : Type u} [comm_ring α] (S : set α) [is_prime_ideal S] :
  ∀ {x y : α}, x * y = 0 → x ∈ S ∨ y ∈ S :=
λ x y hxy, have x * y ∈ S, by rw hxy; from (@is_submodule.zero α α _ _ S _ : (0:α) ∈ S),
is_prime_ideal.mem_or_mem_of_mul_mem this

class is_maximal_ideal {α : Type u} [comm_ring α] (S : set α) extends is_proper_ideal S : Prop :=
mk' ::
  (eq_or_univ_of_subset : ∀ (T : set α) [is_ideal T], S ⊆ T → T = S ∨ T = set.univ)

theorem is_maximal_ideal.mk {α : Type u} [comm_ring α] (S : set α) [is_ideal S]
  (h₁ : (1:α) ∉ S) (h₂ : ∀ x (T : set α) [is_ideal T], S ⊆ T → x ∉ S → x ∈ T → (1:α) ∈ T) :
  is_maximal_ideal S :=
{ ne_univ              := assume hu, have (1:α) ∈ S, by rw hu; trivial, h₁ this,
  eq_or_univ_of_subset := assume T ht hst, classical.or_iff_not_imp_left.2 $ assume (hnst : T ≠ S),
    let ⟨x, hxt, hxns⟩ := set.exists_of_ssubset ⟨hst, hnst.symm⟩ in
    @@is_submodule.univ_of_one_mem _ T (by resetI; apply_instance) $ @@h₂ x T ht hst hxns hxt}

instance is_maximal_ideal.is_prime_ideal (S : set α) [hS : is_maximal_ideal S] : is_prime_ideal S :=
{ mem_or_mem_of_mul_mem := λ x y hxy, or_iff_not_imp_left.2 (λ h,
  have (span (insert x S)) = univ := or.resolve_left (is_maximal_ideal.eq_or_univ_of_subset _
    (subset.trans (subset_insert _ _) subset_span)) (λ hS, h $ hS ▸ subset_span (mem_insert _ _)),
  have (1 : α) ∈ span (insert x S) := this.symm ▸ mem_univ _,
  let ⟨a, ha⟩ := mem_span_insert.1 this in
  have hy : y * (1 + a • x) - a * (x * y) = y := by rw smul_eq_mul; ring,
  hy ▸ is_ideal.sub (is_ideal.mul_left (span_eq_of_is_submodule (show is_submodule S, by apply_instance)
    ▸ ha)) (is_ideal.mul_left hxy)),
  ..hS }

def nonunits (α : Type u) [monoid α] : set α := { x | ¬∃ y, y * x = 1 }

theorem not_unit_of_mem_proper_ideal {α : Type u} [comm_ring α] (S : set α) [is_proper_ideal S] :
  S ⊆ nonunits α :=
λ x hx ⟨y, hxy⟩, is_proper_ideal.ne_univ S $ is_submodule.eq_univ_of_contains_unit S x y hx hxy

class local_ring (α : Type u) [comm_ring α] :=
(S : set α)
(max : is_maximal_ideal S)
(unique : ∀ T [is_maximal_ideal T], S = T)

def local_of_nonunits_ideal {α : Type u} [comm_ring α] (hnze : (0:α) ≠ 1)
  (h : ∀ x y ∈ nonunits α, x + y ∈ nonunits α) : local_ring α :=
have hi : is_ideal (nonunits α), from
  { zero_ := λ ⟨y, hy⟩, hnze $ by simpa using hy,
    add_  := h,
    smul  := λ x y hy ⟨z, hz⟩, hy ⟨x * z, by rw [← hz]; simp [mul_left_comm, mul_assoc]⟩ },
{ S      := nonunits α,
  max    := @@is_maximal_ideal.mk _ (nonunits α) hi (λ ho, ho ⟨1, mul_one 1⟩) $
    λ x T ht hst hxns hxt,
    let ⟨y, hxy⟩ := classical.by_contradiction hxns in
    by rw [← hxy]; by exactI is_ideal.mul_left hxt,
  unique := λ T hmt, or.cases_on
    (@@is_maximal_ideal.eq_or_univ_of_subset _ hmt (nonunits α) hi $
      λ z hz, @@not_unit_of_mem_proper_ideal _ T (by resetI; apply_instance) hz)
    id
    (λ htu, false.elim $ ((set.ext_iff _ _).1 htu 1).2 trivial ⟨1, mul_one 1⟩) }

instance is_ideal.preimage [comm_ring β] (S : set β) (f : α → β)
  [is_ring_hom f] [is_ideal S] : is_ideal (f ⁻¹' S) :=
{ to_is_submodule := { zero_ := show f 0 ∈ S, by rw is_ring_hom.map_zero f; exact is_ideal.zero _,
  add_ := λ x y hx hy, show f (x + y) ∈ S, by rw is_ring_hom.map_add f; exact is_ideal.add hx hy,
  smul := λ c x hx, show f (c * x) ∈ S, by rw is_ring_hom.map_mul f; exact is_ideal.mul_left hx } }

instance is_proper_ideal.preimage [comm_ring β] (S : set β) (f : α → β) [is_ring_hom f]
  [hT : is_proper_ideal S] : is_proper_ideal (f ⁻¹' S) :=
{ ne_univ := mt eq_univ_iff_forall.1 (λ h, is_proper_ideal_iff_one_not_mem.1 hT
    (is_ring_hom.map_one f ▸ h _)),
  ..is_ideal.preimage S f }

instance is_prime_ideal.preimage [comm_ring β] (S : set β) (f : α → β) [is_ring_hom f]
  [is_prime_ideal S] : is_prime_ideal (f ⁻¹' S) :=
{ mem_or_mem_of_mul_mem := λ x y (hxy : f (x * y) ∈ S), show f x ∈ S ∨ f y ∈ S,
    from is_prime_ideal.mem_or_mem_of_mul_mem (by rwa ← is_ring_hom.map_mul f),
  ..is_proper_ideal.preimage S f }

namespace quotient_ring
open is_ideal

def quotient_rel (S : set α) [is_ideal S] := is_submodule.quotient_rel S

def quotient (S : set α) [is_ideal S] := quotient (quotient_rel S)

def mk {S : set α} [is_ideal S] (a : α) : quotient S :=
quotient.mk' a

instance {S : set α} [is_ideal S] : has_coe α (quotient S) := ⟨mk⟩

protected lemma eq {S : set α} [is_ideal S] {a b : α} :
  (a : quotient S) = b ↔ a - b ∈ S := quotient.eq'

instance (S : set α) [is_ideal S] : comm_ring (quotient S) :=
{ mul := λ a b, quotient.lift_on₂' a b (λ a b, ((a * b : α) : quotient S))
  (λ a₁ a₂ b₁ b₂ (h₁ : a₁ - b₁ ∈ S) (h₂ : a₂ - b₂ ∈ S),
    quotient.sound'
    (show a₁ * a₂ - b₁ * b₂ ∈ S, from
    have h : a₂ * (a₁ - b₁) + (a₂ - b₂) * b₁ =
      a₁ * a₂ - b₁ * b₂, by ring,
    h ▸ is_ideal.add (mul_left h₁) (mul_right h₂))),
  mul_assoc := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg mk (mul_assoc a b c),
  mul_comm := λ a b, quotient.induction_on₂' a b $
    λ a b, congr_arg mk (mul_comm a b),
  one := (1 : α),
  one_mul := λ a, quotient.induction_on' a $
    λ a, congr_arg mk (one_mul a),
  mul_one := λ a, quotient.induction_on' a $
    λ a, congr_arg mk (mul_one a),
  left_distrib := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg mk (left_distrib a b c),
  right_distrib := λ a b c, quotient.induction_on₃' a b c $
    λ a b c, congr_arg mk (right_distrib a b c),
  ..quotient_module.quotient.add_comm_group S }

instance is_ring_hom_mk (S : set α) [is_ideal S] :
  @is_ring_hom _ (quotient S) _ _ mk :=
⟨rfl, λ _ _, rfl, λ _ _, rfl⟩

instance (S T : set α) [is_ideal S] [is_ideal T] :
  is_ideal (mk '' S : set (quotient T)) :=
{ to_is_submodule := { zero_ := ⟨0, is_ideal.zero _, rfl⟩,
  add_ := λ x y ⟨a, ha⟩ ⟨b, hb⟩, ⟨a + b, is_ideal.add ha.1 hb.1, ha.2 ▸ hb.2 ▸ rfl⟩,
  smul := λ c x ⟨a, ha⟩, quotient.induction_on' c (λ c, ⟨c * a, mul_left ha.1, ha.2 ▸ rfl⟩) } }

@[simp] lemma coe_zero (S : set α) [is_ideal S] : ((0 : α) : quotient S) = 0 := rfl
@[simp] lemma coe_one (S : set α) [is_ideal S] : ((1 : α) : quotient S) = 1 := rfl
@[simp] lemma coe_add (S : set α) [is_ideal S] (a b : α) : ((a + b : α) : quotient S) = a + b := rfl
@[simp] lemma coe_mul (S : set α) [is_ideal S] (a b : α) : ((a * b : α) : quotient S) = a * b := rfl
@[simp] lemma coe_neg (S : set α) [is_ideal S] (a : α) : ((-a : α) : quotient S) = -a := rfl
@[simp] lemma coe_sub (S : set α) [is_ideal S] (a b : α) : ((a - b : α) : quotient S) = a - b := rfl
@[simp] lemma coe_pow (S : set α) [is_ideal S] (a : α) (n : ℕ) : ((a ^ n : α) : quotient S) = a ^ n :=
by induction n; simp [*, pow_succ]

lemma eq_zero_iff_mem {S : set α} [is_ideal S] :
  (a : quotient S) = 0 ↔ a ∈ S :=
by conv {to_rhs, rw ← sub_zero a }; exact quotient.eq'

instance (S : set α) [is_proper_ideal S] : nonzero_comm_ring (quotient S) :=
{ zero_ne_one := ne.symm $ mt eq_zero_iff_mem.1
    (is_proper_ideal_iff_one_not_mem.1 (by apply_instance)),
  ..quotient_ring.comm_ring S }

instance (S : set α) [is_prime_ideal S] : integral_domain (quotient S) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b,
    quotient.induction_on₂' a b $ λ a b hab,
      (is_prime_ideal.mem_or_mem_of_mul_mem
        (eq_zero_iff_mem.1 hab)).elim
      (or.inl ∘ eq_zero_iff_mem.2)
      (or.inr ∘ eq_zero_iff_mem.2),
  ..quotient_ring.nonzero_comm_ring S }

lemma exists_inv {S : set α} [is_maximal_ideal S] {a : quotient S} : a ≠ 0 →
  ∃ b : quotient S, a * b = 1 :=
quotient.induction_on' a $ λ a ha,
classical.by_contradiction $ λ h,
have haS : a ∉ S := mt eq_zero_iff_mem.2 ha,
by haveI hS : is_proper_ideal (span (set.insert a S)) :=
  is_proper_ideal_iff_one_not_mem.2
  (mt mem_span_insert.1 $ λ ⟨b, hb⟩,
  h ⟨-b, quotient_ring.eq.2
    (neg_iff.2 (begin
      rw [neg_sub, mul_neg_eq_neg_mul_symm, sub_eq_add_neg, neg_neg, mul_comm],
      rw span_eq_of_is_submodule (show is_submodule S, by apply_instance) at hb,
      exact hb
    end))⟩);
exact have span (set.insert a S) = S :=
    or.resolve_right (is_maximal_ideal.eq_or_univ_of_subset (span (set.insert a S))
    (subset.trans (subset_insert _ _) subset_span)) (is_proper_ideal.ne_univ _),
  haS (this ▸ subset_span (mem_insert _ _))

/-- quotient by maximal ideal is a field. def rather than instance, since users will have
computable inverses in some applications -/
protected noncomputable def field (S : set α) [is_maximal_ideal S] : field (quotient S) :=
{ inv := λ a, if ha : a = 0 then 0 else classical.some (exists_inv ha),
  mul_inv_cancel := λ a (ha : a ≠ 0), show a * dite _ _ _ = _,
    by rw dif_neg ha;
    exact classical.some_spec (exists_inv ha),
  inv_mul_cancel := λ a (ha : a ≠ 0), show dite _ _ _ * a = _,
    by rw [mul_comm, dif_neg ha];
    exact classical.some_spec (exists_inv ha),
  ..quotient_ring.integral_domain S }

end quotient_ring


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.int.basic
import Mathlib.algebra.field_power
import Mathlib.ring_theory.multiplicity
import Mathlib.data.real.cau_seq
import Mathlib.tactic.ring_exp
import Mathlib.tactic.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# p-adic norm

This file defines the p-adic valuation and the p-adic norm on ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p.

The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouêva, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

/--
For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `n` such that
p^n divides z.

`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.denom`.
If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
-/
def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
  dite (q ≠ 0 ∧ p ≠ 1)
    (fun (h : q ≠ 0 ∧ p ≠ 1) =>
      ↑(roption.get (multiplicity (↑p) (rat.num q)) sorry) - ↑(roption.get (multiplicity ↑p ↑(rat.denom q)) sorry))
    fun (h : ¬(q ≠ 0 ∧ p ≠ 1)) => 0

/--
A simplification of the definition of `padic_val_rat p q` when `q ≠ 0` and `p` is prime.
-/
theorem padic_val_rat_def (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) : padic_val_rat p q =
  ↑(roption.get (multiplicity (↑p) (rat.num q))
        (iff.mpr multiplicity.finite_int_iff { left := nat.prime.ne_one hp, right := rat.num_ne_zero_of_ne_zero hq })) -
    ↑(roption.get (multiplicity ↑p ↑(rat.denom q))
        (iff.mpr multiplicity.finite_int_iff
          { left := nat.prime.ne_one hp,
            right :=
              eq.mpr
                (id
                  (Eq.trans
                    ((fun (a a_1 : ℤ) (e_1 : a = a_1) (b b_1 : ℤ) (e_2 : b = b_1) => congr (congr_arg ne e_1) e_2)
                      (↑(rat.denom q)) (↑(rat.denom q)) (Eq.refl ↑(rat.denom q)) 0 (↑0) (Eq.symm int.coe_nat_zero))
                    (Eq.trans (propext (ne_from_not_eq ↑(rat.denom q) ↑0))
                      ((fun (a a_1 : Prop) (e_1 : a = a_1) => congr_arg Not e_1) (↑(rat.denom q) = ↑0) (rat.denom q = 0)
                        (propext int.coe_nat_inj')))))
                (eq.mp (propext (ne_from_not_eq (rat.denom q) 0)) (rat.denom_ne_zero q)) })) :=
  dif_pos { left := hq, right := nat.prime.ne_one hp }

namespace padic_val_rat

/--
`padic_val_rat p q` is symmetric in `q`.
-/
@[simp] protected theorem neg {p : ℕ} (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q := sorry

/--
`padic_val_rat p 1` is 0 for any `p`.
-/
@[simp] protected theorem one {p : ℕ} : padic_val_rat p 1 = 0 := sorry

/--
For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1.
-/
@[simp] theorem padic_val_rat_self {p : ℕ} (hp : 1 < p) : padic_val_rat p ↑p = 1 := sorry

/--
The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`.
-/
theorem padic_val_rat_of_int {p : ℕ} (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) : padic_val_rat p ↑z =
  ↑(roption.get (multiplicity (↑p) z) (iff.mpr multiplicity.finite_int_iff { left := hp, right := hz })) := sorry

end padic_val_rat

/--
A convenience function for the case of `padic_val_rat` when both inputs are natural numbers.
-/
def padic_val_nat (p : ℕ) (n : ℕ) : ℕ :=
  int.to_nat (padic_val_rat p ↑n)

/--
`padic_val_nat` is defined as an `int.to_nat` cast; this lemma ensures that the cast is well-behaved.
-/
theorem zero_le_padic_val_rat_of_nat (p : ℕ) (n : ℕ) : 0 ≤ padic_val_rat p ↑n := sorry

/--
`padic_val_rat` coincides with `padic_val_nat`.
-/
@[simp] theorem padic_val_rat_of_nat (p : ℕ) (n : ℕ) : ↑(padic_val_nat p n) = padic_val_rat p ↑n := sorry

/--
A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
-/
theorem padic_val_nat_def {p : ℕ} [hp : fact (nat.prime p)] {n : ℕ} (hn : n ≠ 0) : padic_val_nat p n =
  roption.get (multiplicity p n)
    (iff.mpr multiplicity.finite_nat_iff { left := nat.prime.ne_one hp, right := iff.mpr bot_lt_iff_ne_bot hn }) := sorry

theorem one_le_padic_val_nat_of_dvd {n : ℕ} {p : ℕ} [prime : fact (nat.prime p)] (nonzero : n ≠ 0) (div : p ∣ n) : 1 ≤ padic_val_nat p n := sorry

@[simp] theorem padic_val_nat_zero (m : ℕ) : padic_val_nat m 0 = 0 :=
  eq.mpr (id (Eq.refl (padic_val_nat m 0 = 0))) (Eq.refl (padic_val_nat m 0))

@[simp] theorem padic_val_nat_one (m : ℕ) : padic_val_nat m 1 = 0 := sorry

namespace padic_val_rat

/--
The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`.
-/
theorem finite_int_prime_iff {p : ℕ} [p_prime : fact (nat.prime p)] {a : ℤ} : multiplicity.finite (↑p) a ↔ a ≠ 0 := sorry

/--
A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`.
-/
protected theorem defn (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {n : ℤ} {d : ℤ} (hqz : q ≠ 0) (qdf : q = rat.mk n d) : padic_val_rat p q =
  ↑(roption.get (multiplicity (↑p) n)
        (iff.mpr multiplicity.finite_int_iff
          { left := ne.symm (ne_of_lt (nat.prime.one_lt p_prime)),
            right :=
              fun (hn : n = 0) =>
                False._oldrec
                  (eq.mp
                    (Eq.trans
                      ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2) q q
                        (Eq.refl q) (rat.mk n d) 0
                        (Eq.trans
                          ((fun (ᾰ ᾰ_1 : ℤ) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℤ) (e_2 : ᾰ_2 = ᾰ_3) =>
                              congr (congr_arg rat.mk e_1) e_2)
                            n 0 hn d d (Eq.refl d))
                          (rat.zero_mk d)))
                      (propext (iff_false_intro hqz)))
                    qdf) })) -
    ↑(roption.get (multiplicity (↑p) d)
        (iff.mpr multiplicity.finite_int_iff
          { left := ne.symm (ne_of_lt (nat.prime.one_lt p_prime)),
            right :=
              fun (hd : d = 0) =>
                False._oldrec
                  (eq.mp
                    (Eq.trans
                      ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2) q q
                        (Eq.refl q) (rat.mk n d) 0
                        (Eq.trans
                          ((fun (ᾰ ᾰ_1 : ℤ) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℤ) (e_2 : ᾰ_2 = ᾰ_3) =>
                              congr (congr_arg rat.mk e_1) e_2)
                            n n (Eq.refl n) d 0 hd)
                          (rat.mk_zero n)))
                      (propext (iff_false_intro hqz)))
                    qdf) })) := sorry

/--
A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem mul (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) : padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r := sorry

/--
A rewrite lemma for `padic_val_rat p (q^k) with condition `q ≠ 0`.
-/
protected theorem pow (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) {k : ℕ} : padic_val_rat p (q ^ k) = ↑k * padic_val_rat p q := sorry

/--
A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
-/
protected theorem inv (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) : padic_val_rat p (q⁻¹) = -padic_val_rat p q := sorry

/--
A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem div (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) : padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r := sorry

/--
A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
in terms of divisibility by `p^n`.
-/
theorem padic_val_rat_le_padic_val_rat_iff (p : ℕ) [p_prime : fact (nat.prime p)] {n₁ : ℤ} {n₂ : ℤ} {d₁ : ℤ} {d₂ : ℤ} (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) : padic_val_rat p (rat.mk n₁ d₁) ≤ padic_val_rat p (rat.mk n₂ d₂) ↔ ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ := sorry

/--
Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
p-adic vlauation of `q + r`.
-/
theorem le_padic_val_rat_add_of_le (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) (h : padic_val_rat p q ≤ padic_val_rat p r) : padic_val_rat p q ≤ padic_val_rat p (q + r) := sorry

/--
The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
-/
theorem min_le_padic_val_rat_add (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) : min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) := sorry

/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
  (if the sum is non-zero). -/
theorem sum_pos_of_pos (p : ℕ) [p_prime : fact (nat.prime p)] {n : ℕ} {F : ℕ → ℚ} (hF : ∀ (i : ℕ), i < n → 0 < padic_val_rat p (F i)) (hn0 : (finset.sum (finset.range n) fun (i : ℕ) => F i) ≠ 0) : 0 < padic_val_rat p (finset.sum (finset.range n) fun (i : ℕ) => F i) := sorry

end padic_val_rat

namespace padic_val_nat

/--
A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`.
-/
protected theorem mul (p : ℕ) [p_prime : fact (nat.prime p)] {q : ℕ} {r : ℕ} (hq : q ≠ 0) (hr : r ≠ 0) : padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r := sorry

/--
Dividing out by a prime factor reduces the padic_val_nat by 1.
-/
protected theorem div {p : ℕ} [p_prime : fact (nat.prime p)] {b : ℕ} (dvd : p ∣ b) : padic_val_nat p (b / p) = padic_val_nat p b - 1 := sorry

end padic_val_nat

/--
If a prime doesn't appear in `n`, `padic_val_nat p n` is `0`.
-/
theorem padic_val_nat_of_not_dvd {p : ℕ} [fact (nat.prime p)] {n : ℕ} (not_dvd : ¬p ∣ n) : padic_val_nat p n = 0 := sorry

theorem dvd_of_one_le_padic_val_nat {n : ℕ} {p : ℕ} [prime : fact (nat.prime p)] (hp : 1 ≤ padic_val_nat p n) : p ∣ n := sorry

theorem padic_val_nat_primes {p : ℕ} {q : ℕ} [p_prime : fact (nat.prime p)] [q_prime : fact (nat.prime q)] (neq : p ≠ q) : padic_val_nat p q = 0 :=
  padic_val_nat_of_not_dvd (iff.mp (not_congr (iff.symm (nat.prime_dvd_prime_iff_eq p_prime q_prime))) neq)

protected theorem padic_val_nat.div' {p : ℕ} [p_prime : fact (nat.prime p)] {m : ℕ} (cpm : nat.coprime p m) {b : ℕ} (dvd : m ∣ b) : padic_val_nat p (b / m) = padic_val_nat p b := sorry

theorem padic_val_nat_eq_factors_count (p : ℕ) [hp : fact (nat.prime p)] (n : ℕ) : padic_val_nat p n = list.count p (nat.factors n) := sorry

theorem prod_pow_prime_padic_val_nat (n : ℕ) (hn : n ≠ 0) (m : ℕ) (pr : n < m) : (finset.prod (finset.filter nat.prime (finset.range m)) fun (p : ℕ) => p ^ padic_val_nat p n) = n := sorry

/--
If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
If `q = 0`, the p-adic norm of `q` is 0.
-/
def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
  ite (q = 0) 0 (↑p ^ (-padic_val_rat p q))

namespace padic_norm

/--
Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`.
-/
@[simp] protected theorem eq_fpow_of_nonzero (p : ℕ) {q : ℚ} (hq : q ≠ 0) : padic_norm p q = ↑p ^ (-padic_val_rat p q) := sorry

/--
The p-adic norm is nonnegative.
-/
protected theorem nonneg (p : ℕ) (q : ℚ) : 0 ≤ padic_norm p q := sorry

/--
The p-adic norm of 0 is 0.
-/
@[simp] protected theorem zero (p : ℕ) : padic_norm p 0 = 0 := sorry

/--
The p-adic norm of 1 is 1.
-/
@[simp] protected theorem one (p : ℕ) : padic_norm p 1 = 1 := sorry

/--
The p-adic norm of `p` is `1/p` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
-/
theorem padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p ↑p = 1 / ↑p := sorry

/--
The p-adic norm of `p` is `1/p` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
-/
@[simp] theorem padic_norm_p_of_prime (p : ℕ) [fact (nat.prime p)] : padic_norm p ↑p = 1 / ↑p :=
  padic_norm_p (nat.prime.one_lt _inst_1)

/--
The p-adic norm of `p` is less than 1 if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
-/
theorem padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p ↑p < 1 := sorry

/--
The p-adic norm of `p` is less than 1 if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
-/
theorem padic_norm_p_lt_one_of_prime (p : ℕ) [fact (nat.prime p)] : padic_norm p ↑p < 1 :=
  padic_norm_p_lt_one (nat.prime.one_lt _inst_1)

/--
`padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`.
-/
protected theorem values_discrete (p : ℕ) {q : ℚ} (hq : q ≠ 0) : ∃ (z : ℤ), padic_norm p q = ↑p ^ (-z) := sorry

/--
`padic_norm p` is symmetric.
-/
@[simp] protected theorem neg (p : ℕ) (q : ℚ) : padic_norm p (-q) = padic_norm p q := sorry

/--
If `q ≠ 0`, then `padic_norm p q ≠ 0`.
-/
protected theorem nonzero (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 := sorry

/--
If the p-adic norm of `q` is 0, then `q` is 0.
-/
theorem zero_of_padic_norm_eq_zero (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} (h : padic_norm p q = 0) : q = 0 := sorry

/--
The p-adic norm is multiplicative.
-/
@[simp] protected theorem mul (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) : padic_norm p (q * r) = padic_norm p q * padic_norm p r := sorry

/--
The p-adic norm respects division.
-/
@[simp] protected theorem div (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r := sorry

/--
The p-adic norm of an integer is at most 1.
-/
protected theorem of_int (p : ℕ) [hp : fact (nat.prime p)] (z : ℤ) : padic_norm p ↑z ≤ 1 := sorry

/--
The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
the norm of `q`.
-/
protected theorem nonarchimedean (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ} : padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) := sorry

/--
The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
plus the norm of `q`.
-/
theorem triangle_ineq (p : ℕ) [hp : fact (nat.prime p)] (q : ℚ) (r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
  le_trans (padic_norm.nonarchimedean p) (max_le_add_of_nonneg (padic_norm.nonneg p q) (padic_norm.nonneg p r))

/--
The p-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the p-adic norm.
-/
protected theorem sub (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) := sorry

/--
If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
the norms of `q` and `r`.
-/
theorem add_eq_max_of_ne (p : ℕ) [hp : fact (nat.prime p)] {q : ℚ} {r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) : padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) := sorry

/--
The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
inequality.
-/
protected instance is_absolute_value (p : ℕ) [hp : fact (nat.prime p)] : is_absolute_value (padic_norm p) :=
  is_absolute_value.mk (padic_norm.nonneg p)
    (fun (x : ℚ) =>
      { mp := fun (ᾰ : padic_norm p x = 0) => zero_of_padic_norm_eq_zero p ᾰ,
        mpr :=
          fun (ᾰ : x = 0) =>
            eq.mpr
              (id
                (Eq.trans
                  ((fun (a a_1 : ℚ) (e_1 : a = a_1) (ᾰ ᾰ_1 : ℚ) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
                    (padic_norm p x) 0
                    (Eq.trans
                      ((fun (p p_1 : ℕ) (e_1 : p = p_1) (q q_1 : ℚ) (e_2 : q = q_1) =>
                          congr (congr_arg padic_norm e_1) e_2)
                        p p (Eq.refl p) x 0 ᾰ)
                      (padic_norm.zero p))
                    0 0 (Eq.refl 0))
                  (propext (eq_self_iff_true 0))))
              trivial })
    (triangle_ineq p) (padic_norm.mul p)

theorem dvd_iff_norm_le {p : ℕ} [hp : fact (nat.prime p)] {n : ℕ} {z : ℤ} : ↑(p ^ n) ∣ z ↔ padic_norm p ↑z ≤ ↑p ^ (-↑n) := sorry


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.Queue
import LeanColls.LazyList

namespace LeanColls

/-!
# Lazy Batched Queues

Amortized, lazy queue implementation.

Essentially the same as `BatchQueue`, but amortized costs
are shared across all persistent copies of the queue
by lazily flipping the back of the queue periodically.

## References

See [Okasaki1996], Section 3.4.2

-/
structure LazyBatchQueue (τ) :=
  F : LazyList τ
  F_len : Nat
  R : LazyList τ
  R_len : Nat
  h_lens : F.length = F_len ∧ R.length = R_len ∧ R_len ≤ F_len

namespace LazyBatchQueue

private def model_fn : LazyBatchQueue τ → List τ := λ ⟨F,_,R,_,_⟩ => (F ++ (R.reverse)).toList

def empty : LazyBatchQueue τ :=
  ⟨ LazyList.nil, 0,
    LazyList.nil, 0,
    by simp⟩

private def balance (F : LazyList τ) (F_len) (R : LazyList τ) (R_len)
  (h_lens : F.length = F_len ∧ R.length = R_len) :=
  if h : R_len ≤ F_len then
    (⟨F, F_len, R, R_len,
      by
      cases h_lens
      apply And.intro; assumption;
      apply And.intro; assumption; assumption
    ⟩ : LazyBatchQueue τ)
  else
    ⟨ F ++ R.reverse, F_len + R_len,
      LazyList.nil, 0,
      by
      cases h_lens; case intro l r =>
      simp
      simp [l, r]
    ⟩

private theorem balance_inv {F : LazyList α} {F_len} {R} {R_len} {h_lens}
  : model_fn (balance F F_len R R_len h_lens) = (F ++ (R.reverse)).toList
  := by
  simp [balance]
  cases (Nat.decLe R_len F_len)
  simp [dite, model_fn]
  simp [dite, model_fn]

def enq (Q : LazyBatchQueue τ) (x : τ) : LazyBatchQueue τ :=
  let ⟨F, F_len, R, R_len, h_lens⟩ := Q
  balance F F_len (LazyList.cons x R) (1+R_len) (by
    simp
    cases h_lens; case intro l r =>
    simp [l,r, Nat.add_comm]
    )

def deq (Q : LazyBatchQueue τ) : Option (τ × LazyBatchQueue τ) :=
  let ⟨F, F_len, R, R_len, h_lens⟩ := Q
  match h:F.force with
  | some (x, F') => some (x, balance F' (F_len-1) R R_len (by
      rw [←LazyList.length_toList, LazyList.toList_force_some h] at h_lens
      simp at h_lens
      rw [←h_lens.1, h_lens.2.1]
      simp [Nat.succ_sub_succ, Nat.sub_zero]
    ))
  | none => none

instance : Queue (LazyBatchQueue τ) τ where
  empty := empty
  enq   := enq
  deq   := deq

instance : instQueueLazyBatchQueue.CorrectFIFO (τ := τ) where
  model := model_fn
  h_empty := by simp [empty, model_fn]
  h_enq := by
    intros c x
    cases c; case mk F F_len R R_len h_lens =>
    simp [Queue.enq, enq, balance_inv]
    simp [model_fn]
    rw [←List.append_assoc]
  h_deq := by
    intro c
    cases c; case mk F F_len R R_len h_lens =>
    simp [Queue.deq, deq]
    match h_lens with
    | ⟨hf, hr, h_lens'⟩ =>
    split
    case h_2 h =>
      simp [Option.map, Option.bind, model_fn]
      have hF : F.toList = []
        := LazyList.toList_force_none.mp h
      have hFL : F_len = 0
        := by
        rw [←LazyList.length_toList] at hf
        simp [hF] at hf
        exact hf.symm
      have hRL : R_len = 0
        := by
        rw [hFL] at h_lens'
        exact Nat.eq_zero_of_le_zero h_lens'
      have hR : R.toList = []
        := by
        rw [hRL] at hr
        rw [←LazyList.length_toList] at hr
        unfold List.length at hr
        split at hr
        assumption
        contradiction
      simp [hF, hR, List.front?]
    case h_1 x F' h =>
      simp [Option.map, Option.bind, model_fn]
      have hF : F.toList = x :: F'.toList
        := LazyList.toList_force_some h
      simp [hF, List.front?]
      suffices _ by
        have := @balance_inv _ F' (F_len-1) R R_len this
        simp [model_fn] at this
        exact this.symm

end LazyBatchQueue