/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import algebra.order.nonneg.ring
import algebra.order.archimedean

/-!
# Nonnegative elements are archimedean

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

This file defines instances and prove some properties about the nonnegative elements
`{x : α // 0 ≤ x}` of an arbitrary type `α`.

This is used to derive algebraic structures on `ℝ≥0` and `ℚ≥0` automatically.

## Main declarations

* `{x : α // 0 ≤ x}` is a `floor_semiring` if `α` is.
-/

namespace nonneg
variables {α : Type*}

instance archimedean [ordered_add_comm_monoid α] [archimedean α] : archimedean {x : α // 0 ≤ x} :=
⟨λ x y hy,
  let ⟨n, hr⟩ := archimedean.arch (x : α) (hy : (0 : α) < y) in
  ⟨n, show (x : α) ≤ (n • y : {x : α // 0 ≤ x}), by simp [*, -nsmul_eq_mul, nsmul_coe]⟩⟩

instance floor_semiring [ordered_semiring α] [floor_semiring α] : floor_semiring {r : α // 0 ≤ r} :=
{ floor := λ a, ⌊(a : α)⌋₊,
  ceil := λ a, ⌈(a : α)⌉₊,
  floor_of_neg := λ a ha, floor_semiring.floor_of_neg ha,
  gc_floor := λ a n ha, begin
    refine (floor_semiring.gc_floor (show 0 ≤ (a : α), from ha)).trans _,
    rw [←subtype.coe_le_coe, nonneg.coe_nat_cast]
  end,
  gc_ceil := λ a n, begin
    refine (floor_semiring.gc_ceil (a : α) n).trans _,
    rw [←subtype.coe_le_coe, nonneg.coe_nat_cast]
  end}

@[norm_cast] lemma nat_floor_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) :
  ⌊(a : α)⌋₊ = ⌊a⌋₊ := rfl

@[norm_cast] lemma nat_ceil_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) :
  ⌈(a : α)⌉₊ = ⌈a⌉₊  := rfl

end nonneg


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import data.dfinsupp
import group_theory.submonoid.operations
import group_theory.subgroup.basic

/-!
# Direct sum

This file defines the direct sum of abelian groups, indexed by a discrete type.

## Notation

`⨁ i, β i` is the n-ary direct sum `direct_sum`.
This notation is in the `direct_sum` locale, accessible after `open_locale direct_sum`.

## References

* https://en.wikipedia.org/wiki/Direct_sum
-/

open_locale big_operators

universes u v w u₁

variables (ι : Type v) [dec_ι : decidable_eq ι] (β : ι → Type w)

/-- `direct_sum β` is the direct sum of a family of additive commutative monoids `β i`.

Note: `open_locale direct_sum` will enable the notation `⨁ i, β i` for `direct_sum β`. -/
@[derive [add_comm_monoid, inhabited]]
def direct_sum [Π i, add_comm_monoid (β i)] : Type* := Π₀ i, β i

instance [Π i, add_comm_monoid (β i)] : has_coe_to_fun (direct_sum ι β) (λ _, Π i : ι, β i) :=
dfinsupp.has_coe_to_fun

localized "notation `⨁` binders `, ` r:(scoped f, direct_sum _ f) := r" in direct_sum

namespace direct_sum

variables {ι}

section add_comm_group

variables [Π i, add_comm_group (β i)]

instance : add_comm_group (direct_sum ι β) := dfinsupp.add_comm_group

variables {β}
@[simp] lemma sub_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ - g₂) i = g₁ i - g₂ i :=
dfinsupp.sub_apply _ _ _

end add_comm_group

variables [Π i, add_comm_monoid (β i)]

@[simp] lemma zero_apply (i : ι) : (0 : ⨁ i, β i) i = 0 := rfl

variables {β}
@[simp] lemma add_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ + g₂) i = g₁ i + g₂ i :=
dfinsupp.add_apply _ _ _

variables (β)
include dec_ι

/-- `mk β s x` is the element of `⨁ i, β i` that is zero outside `s`
and has coefficient `x i` for `i` in `s`. -/
def mk (s : finset ι) : (Π i : (↑s : set ι), β i.1) →+ ⨁ i, β i :=
{ to_fun := dfinsupp.mk s,
  map_add' := λ _ _, dfinsupp.mk_add,
  map_zero' := dfinsupp.mk_zero, }

/-- `of i` is the natural inclusion map from `β i` to `⨁ i, β i`. -/
def of (i : ι) : β i →+ ⨁ i, β i :=
dfinsupp.single_add_hom β i

@[simp] lemma of_eq_same (i : ι) (x : β i) : (of _ i x) i = x :=
dfinsupp.single_eq_same

lemma of_eq_of_ne (i j : ι) (x : β i) (h : i ≠ j) : (of _ i x) j = 0 :=
dfinsupp.single_eq_of_ne h

@[simp] lemma support_zero [Π (i : ι) (x : β i), decidable (x ≠ 0)] :
  (0 : ⨁ i, β i).support = ∅ := dfinsupp.support_zero

@[simp] lemma support_of [Π (i : ι) (x : β i), decidable (x ≠ 0)]
  (i : ι) (x : β i) (h : x ≠ 0) :
  (of _ i x).support = {i} := dfinsupp.support_single_ne_zero h

lemma support_of_subset [Π (i : ι) (x : β i), decidable (x ≠ 0)] {i : ι} {b : β i} :
  (of _ i b).support ⊆ {i} := dfinsupp.support_single_subset

lemma sum_support_of [Π (i : ι) (x : β i), decidable (x ≠ 0)] (x : ⨁ i, β i) :
  ∑ i in x.support, of β i (x i) = x := dfinsupp.sum_single

variables {β}

theorem mk_injective (s : finset ι) : function.injective (mk β s) :=
dfinsupp.mk_injective s

theorem of_injective (i : ι) : function.injective (of β i) :=
dfinsupp.single_injective

@[elab_as_eliminator]
protected theorem induction_on {C : (⨁ i, β i) → Prop}
  (x : ⨁ i, β i) (H_zero : C 0)
  (H_basic : ∀ (i : ι) (x : β i), C (of β i x))
  (H_plus : ∀ x y, C x → C y → C (x + y)) : C x :=
begin
  apply dfinsupp.induction x H_zero,
  intros i b f h1 h2 ih,
  solve_by_elim
end

/-- If two additive homomorphisms from `⨁ i, β i` are equal on each `of β i y`,
then they are equal. -/
lemma add_hom_ext {γ : Type*} [add_monoid γ] ⦃f g : (⨁ i, β i) →+ γ⦄
  (H : ∀ (i : ι) (y : β i), f (of _ i y) = g (of _ i y)) : f = g :=
dfinsupp.add_hom_ext H

/-- If two additive homomorphisms from `⨁ i, β i` are equal on each `of β i y`,
then they are equal.

See note [partially-applied ext lemmas]. -/
@[ext] lemma add_hom_ext' {γ : Type*} [add_monoid γ] ⦃f g : (⨁ i, β i) →+ γ⦄
  (H : ∀ (i : ι), f.comp (of _ i) = g.comp (of _ i)) : f = g :=
add_hom_ext $ λ i, add_monoid_hom.congr_fun $ H i

variables {γ : Type u₁} [add_comm_monoid γ]

section to_add_monoid

variables (φ : Π i, β i →+ γ) (ψ : (⨁ i, β i) →+ γ)

/-- `to_add_monoid φ` is the natural homomorphism from `⨁ i, β i` to `γ`
induced by a family `φ` of homomorphisms `β i → γ`. -/
def to_add_monoid : (⨁ i, β i) →+ γ :=
(dfinsupp.lift_add_hom φ)

@[simp] lemma to_add_monoid_of (i) (x : β i) : to_add_monoid φ (of β i x) = φ i x :=
dfinsupp.lift_add_hom_apply_single φ i x

theorem to_add_monoid.unique (f : ⨁ i, β i) :
  ψ f = to_add_monoid (λ i, ψ.comp (of β i)) f :=
by {congr, ext, simp [to_add_monoid, of]}

end to_add_monoid

section from_add_monoid

/-- `from_add_monoid φ` is the natural homomorphism from `γ` to `⨁ i, β i`
induced by a family `φ` of homomorphisms `γ → β i`.

Note that this is not an isomorphism. Not every homomorphism `γ →+ ⨁ i, β i` arises in this way. -/
def from_add_monoid : (⨁ i, γ →+ β i) →+ (γ →+ ⨁ i, β i) :=
to_add_monoid $ λ i, add_monoid_hom.comp_hom (of β i)

@[simp] lemma from_add_monoid_of (i : ι) (f : γ →+ β i) :
  from_add_monoid (of _ i f) = (of _ i).comp f :=
by { rw [from_add_monoid, to_add_monoid_of], refl }

lemma from_add_monoid_of_apply (i : ι) (f : γ →+ β i) (x : γ) :
  from_add_monoid (of _ i f) x = of _ i (f x) :=
by rw [from_add_monoid_of, add_monoid_hom.coe_comp]

end from_add_monoid

variables (β)
/-- `set_to_set β S T h` is the natural homomorphism `⨁ (i : S), β i → ⨁ (i : T), β i`,
where `h : S ⊆ T`. -/
-- TODO: generalize this to remove the assumption `S ⊆ T`.
def set_to_set (S T : set ι) (H : S ⊆ T) :
  (⨁ (i : S), β i) →+ (⨁ (i : T), β i) :=
to_add_monoid $ λ i, of (λ (i : subtype T), β i) ⟨↑i, H i.prop⟩
variables {β}

omit dec_ι

/-- The natural equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def id (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [unique ι] :
  (⨁ (_ : ι), M) ≃+ M :=
{ to_fun := direct_sum.to_add_monoid (λ _, add_monoid_hom.id M),
  inv_fun := of (λ _, M) (default ι),
  left_inv := λ x, direct_sum.induction_on x
    (by rw [add_monoid_hom.map_zero, add_monoid_hom.map_zero])
    (λ p x, by rw [unique.default_eq p, to_add_monoid_of]; refl)
    (λ x y ihx ihy, by rw [add_monoid_hom.map_add, add_monoid_hom.map_add, ihx, ihy]),
  right_inv := λ x, to_add_monoid_of _ _ _,
  ..direct_sum.to_add_monoid (λ _, add_monoid_hom.id M) }

/-- The canonical embedding from `⨁ i, A i` to `M` where `A` is a collection of `add_submonoid M`
indexed by `ι`-/
def add_submonoid_coe {M : Type*} [decidable_eq ι] [add_comm_monoid M]
  (A : ι → add_submonoid M) : (⨁ i, A i) →+ M :=
to_add_monoid (λ i, (A i).subtype)

@[simp] lemma add_submonoid_coe_of {M : Type*} [decidable_eq ι] [add_comm_monoid M]
  (A : ι → add_submonoid M) (i : ι) (x : A i) :
  add_submonoid_coe A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

lemma coe_of_add_submonoid_apply {M : Type*} [decidable_eq ι] [add_comm_monoid M]
  {A : ι → add_submonoid M} (i j : ι) (x : A i) :
  (of _ i x j : M) = if i = j then x else 0 :=
begin
  obtain rfl | h := decidable.eq_or_ne i j,
  { rw [direct_sum.of_eq_same, if_pos rfl], },
  { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, add_submonoid.coe_zero], },
end

/-- The `direct_sum` formed by a collection of `add_submonoid`s of `M` is said to be internal if the
canonical map `(⨁ i, A i) →+ M` is bijective.

See `direct_sum.add_subgroup_is_internal` for the same statement about `add_subgroup`s. -/
def add_submonoid_is_internal {M : Type*} [decidable_eq ι] [add_comm_monoid M]
  (A : ι → add_submonoid M) : Prop :=
function.bijective (add_submonoid_coe A)

lemma add_submonoid_is_internal.supr_eq_top {M : Type*} [decidable_eq ι] [add_comm_monoid M]
  (A : ι → add_submonoid M)
  (h : add_submonoid_is_internal A) : supr A = ⊤ :=
begin
  rw [add_submonoid.supr_eq_mrange_dfinsupp_sum_add_hom, add_monoid_hom.mrange_top_iff_surjective],
  exact function.bijective.surjective h,
end

/-- The canonical embedding from `⨁ i, A i` to `M`  where `A` is a collection of `add_subgroup M`
indexed by `ι`-/
def add_subgroup_coe {M : Type*} [decidable_eq ι] [add_comm_group M]
  (A : ι → add_subgroup M) : (⨁ i, A i) →+ M :=
to_add_monoid (λ i, (A i).subtype)

@[simp] lemma add_subgroup_coe_of {M : Type*} [decidable_eq ι] [add_comm_group M]
  (A : ι → add_subgroup M) (i : ι) (x : A i) :
  add_subgroup_coe A (of (λ i, A i) i x) = x :=
to_add_monoid_of _ _ _

lemma coe_of_add_subgroup_apply {M : Type*} [decidable_eq ι] [add_comm_group M]
  {A : ι → add_subgroup M} (i j : ι) (x : A i) :
  (of _ i x j : M) = if i = j then x else 0 :=
begin
  obtain rfl | h := decidable.eq_or_ne i j,
  { rw [direct_sum.of_eq_same, if_pos rfl], },
  { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, add_subgroup.coe_zero], },
end

/-- The `direct_sum` formed by a collection of `add_subgroup`s of `M` is said to be internal if the
canonical map `(⨁ i, A i) →+ M` is bijective.

See `direct_sum.submodule_is_internal` for the same statement about `submodules`s. -/
def add_subgroup_is_internal {M : Type*} [decidable_eq ι] [add_comm_group M]
  (A : ι → add_subgroup M) : Prop :=
function.bijective (add_subgroup_coe A)

lemma add_subgroup_is_internal.to_add_submonoid
  {M : Type*} [decidable_eq ι] [add_comm_group M] (A : ι → add_subgroup M) :
  add_subgroup_is_internal A ↔
    add_submonoid_is_internal (λ i, (A i).to_add_submonoid) :=
iff.rfl

end direct_sum


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

! This file was ported from Lean 3 source module data.dfinsupp.interval
! leanprover-community/mathlib commit 98e83c3d541c77cdb7da20d79611a780ff8e7d90
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.LocallyFinite
import Mathlib.Data.Finset.Pointwise
import Mathlib.Data.Fintype.BigOperators
import Mathlib.Data.Dfinsupp.Order

/-!
# Finite intervals of finitely supported functions

This file provides the `LocallyFiniteOrder` instance for `Π₀ i, α i` when `α` itself is locally
finite and calculates the cardinality of its finite intervals.
-/

open Dfinsupp Finset

open BigOperators Pointwise

variable {ι : Type _} {α : ι → Type _}

namespace Finset

variable [DecidableEq ι] [∀ i, Zero (α i)] {s : Finset ι} {f : Π₀ i, α i} {t : ∀ i, Finset (α i)}

/-- Finitely supported product of finsets. -/
def dfinsupp (s : Finset ι) (t : ∀ i, Finset (α i)) : Finset (Π₀ i, α i) :=
  (s.pi t).map
    ⟨fun f => Dfinsupp.mk s fun i => f i i.2, by
      refine' (mk_injective _).comp fun f g h => _
      ext (i hi)
      convert congr_fun h ⟨i, hi⟩⟩
#align finset.dfinsupp Finset.dfinsupp

@[simp]
theorem card_dfinsupp (s : Finset ι) (t : ∀ i, Finset (α i)) :
    (s.dfinsupp t).card = ∏ i in s, (t i).card :=
  (card_map _).trans <| card_pi _ _
#align finset.card_dfinsupp Finset.card_dfinsupp

variable [∀ i, DecidableEq (α i)]

theorem mem_dfinsupp_iff : f ∈ s.dfinsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i := by
  refine' mem_map.trans ⟨_, _⟩
  · rintro ⟨f, hf, rfl⟩
    rw [Function.Embedding.coeFn_mk] -- porting note: added to avoid hearbeat timeout
    refine' ⟨support_mk_subset, fun i hi => _⟩
    convert mem_pi.1 hf i hi
    exact mk_of_mem hi
  · refine' fun h => ⟨fun i _ => f i, mem_pi.2 h.2, _⟩
    ext i
    dsimp
    exact ite_eq_left_iff.2 fun hi => (not_mem_support_iff.1 fun H => hi <| h.1 H).symm
#align finset.mem_dfinsupp_iff Finset.mem_dfinsupp_iff

/-- When `t` is supported on `s`, `f ∈ s.dfinsupp t` precisely means that `f` is pointwise in `t`.
-/
@[simp]
theorem mem_dfinsupp_iff_of_support_subset {t : Π₀ i, Finset (α i)} (ht : t.support ⊆ s) :
    f ∈ s.dfinsupp t ↔ ∀ i, f i ∈ t i := by
  refine' mem_dfinsupp_iff.trans (forall_and.symm.trans <| forall_congr' fun i =>
      ⟨ fun h => _,
        fun h => ⟨fun hi => ht <| mem_support_iff.2 fun H => mem_support_iff.1 hi _, fun _ => h⟩⟩)
  · by_cases hi : i ∈ s
    · exact h.2 hi
    · rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (not_mem_mono ht hi)]
      exact zero_mem_zero
  · rwa [H, mem_zero] at h
#align finset.mem_dfinsupp_iff_of_support_subset Finset.mem_dfinsupp_iff_of_support_subset

end Finset

open Finset

namespace Dfinsupp

section BundledSingleton

variable [∀ i, Zero (α i)] {f : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `Finset.singleton` bundled as a `Dfinsupp`. -/
def singleton (f : Π₀ i, α i) : Π₀ i, Finset (α i) where
  toFun i := {f i}
  support' := f.support'.map fun s => ⟨s.1, fun i => (s.prop i).imp id (congr_arg _)⟩
#align dfinsupp.singleton Dfinsupp.singleton

theorem mem_singleton_apply_iff : a ∈ f.singleton i ↔ a = f i :=
  mem_singleton
#align dfinsupp.mem_singleton_apply_iff Dfinsupp.mem_singleton_apply_iff

end BundledSingleton

section BundledIcc

variable [∀ i, Zero (α i)] [∀ i, PartialOrder (α i)] [∀ i, LocallyFiniteOrder (α i)]
  {f g : Π₀ i, α i} {i : ι} {a : α i}

/-- Pointwise `Finset.Icc` bundled as a `Dfinsupp`. -/
def rangeIcc (f g : Π₀ i, α i) : Π₀ i, Finset (α i) where
  toFun i := Icc (f i) (g i)
  support' := f.support'.bind fun fs => g.support'.map fun gs =>
    ⟨ fs.1 + gs.1,
      fun i => or_iff_not_imp_left.2 fun h => by
        have hf : f i = 0 := (fs.prop i).resolve_left
            (Multiset.not_mem_mono (Multiset.Le.subset <| Multiset.le_add_right _ _) h)
        have hg : g i = 0 := (gs.prop i).resolve_left
            (Multiset.not_mem_mono (Multiset.Le.subset <| Multiset.le_add_left _ _) h)
        -- porting note: was rw, but was rewriting under lambda, so changed to simp_rw
        simp_rw [hf, hg]
        exact Icc_self _⟩
#align dfinsupp.range_Icc Dfinsupp.rangeIcc

@[simp]
theorem rangeIcc_apply (f g : Π₀ i, α i) (i : ι) : f.rangeIcc g i = Icc (f i) (g i) := rfl
#align dfinsupp.range_Icc_apply Dfinsupp.rangeIcc_apply

theorem mem_rangeIcc_apply_iff : a ∈ f.rangeIcc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc
#align dfinsupp.mem_range_Icc_apply_iff Dfinsupp.mem_rangeIcc_apply_iff

theorem support_rangeIcc_subset [DecidableEq ι] [∀ i, DecidableEq (α i)] :
    (f.rangeIcc g).support ⊆ f.support ∪ g.support := by
  refine' fun x hx => _
  by_contra h
  refine' not_mem_support_iff.2 _ hx
  rw [rangeIcc_apply, not_mem_support_iff.1 (not_mem_mono (subset_union_left _ _) h),
    not_mem_support_iff.1 (not_mem_mono (subset_union_right _ _) h)]
  exact Icc_self _
#align dfinsupp.support_range_Icc_subset Dfinsupp.support_rangeIcc_subset

end BundledIcc

section Pi

variable [∀ i, Zero (α i)] [DecidableEq ι] [∀ i, DecidableEq (α i)]

/-- Given a finitely supported function `f : Π₀ i, Finset (α i)`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : Π₀ i, Finset (α i)) : Finset (Π₀ i, α i) := f.support.dfinsupp f
#align dfinsupp.pi Dfinsupp.pi

@[simp]
theorem mem_pi {f : Π₀ i, Finset (α i)} {g : Π₀ i, α i} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
  mem_dfinsupp_iff_of_support_subset <| Subset.refl _
#align dfinsupp.mem_pi Dfinsupp.mem_pi

@[simp]
theorem card_pi (f : Π₀ i, Finset (α i)) : f.pi.card = f.prod fun i => (f i).card := by
  rw [pi, card_dfinsupp]
  exact Finset.prod_congr rfl fun i _ => by simp only [Pi.nat_apply, Nat.cast_id]
#align dfinsupp.card_pi Dfinsupp.card_pi

end Pi

section LocallyFinite

variable [DecidableEq ι] [∀ i, DecidableEq (α i)]

variable [∀ i, PartialOrder (α i)] [∀ i, Zero (α i)] [∀ i, LocallyFiniteOrder (α i)]

instance : LocallyFiniteOrder (Π₀ i, α i) :=
  LocallyFiniteOrder.ofIcc (Π₀ i, α i)
    (fun f g => (f.support ∪ g.support).dfinsupp <| f.rangeIcc g)
    (fun f g x => by
      refine' (mem_dfinsupp_iff_of_support_subset <| support_rangeIcc_subset).trans _
      simp_rw [mem_rangeIcc_apply_iff, forall_and]
      rfl)

variable (f g : Π₀ i, α i)

theorem Icc_eq : Icc f g = (f.support ∪ g.support).dfinsupp (f.rangeIcc g) := rfl
#align dfinsupp.Icc_eq Dfinsupp.Icc_eq

theorem card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card :=
  card_dfinsupp _ _
#align dfinsupp.card_Icc Dfinsupp.card_Icc

theorem card_Ico : (Ico f g).card = (∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card) - 1 := by
  rw [card_Ico_eq_card_Icc_sub_one, card_Icc]
#align dfinsupp.card_Ico Dfinsupp.card_Ico

theorem card_Ioc : (Ioc f g).card = (∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card) - 1 := by
  rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]
#align dfinsupp.card_Ioc Dfinsupp.card_Ioc

theorem card_Ioo : (Ioo f g).card = (∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card) - 2 := by
  rw [card_Ioo_eq_card_Icc_sub_two, card_Icc]
#align dfinsupp.card_Ioo Dfinsupp.card_Ioo

end LocallyFinite

section CanonicallyOrdered

variable [DecidableEq ι] [∀ i, DecidableEq (α i)]

variable [∀ i, CanonicallyOrderedAddMonoid (α i)] [∀ i, LocallyFiniteOrder (α i)]

variable (f : Π₀ i, α i)

theorem card_Iic : (Iic f).card = ∏ i in f.support, (Iic (f i)).card := by
  simp_rw [Iic_eq_Icc, card_Icc, Dfinsupp.bot_eq_zero, support_zero, empty_union, zero_apply,
    bot_eq_zero]
#align dfinsupp.card_Iic Dfinsupp.card_Iic

theorem card_Iio : (Iio f).card = (∏ i in f.support, (Iic (f i)).card) - 1 := by
  rw [card_Iio_eq_card_Iic_sub_one, card_Iic]
#align dfinsupp.card_Iio Dfinsupp.card_Iio

end CanonicallyOrdered

end Dfinsupp


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

! This file was ported from Lean 3 source module ring_theory.valuation.valuation_ring
! leanprover-community/mathlib commit a47cda9662ff3925c6df271090b5808adbca5b46
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Valuation.Integers
import Mathbin.RingTheory.Ideal.LocalRing
import Mathbin.RingTheory.Localization.FractionRing
import Mathbin.RingTheory.Localization.Integer
import Mathbin.RingTheory.DiscreteValuationRing
import Mathbin.RingTheory.Bezout
import Mathbin.Tactic.FieldSimp

/-!
# Valuation Rings

A valuation ring is a domain such that for every pair of elements `a b`, either `a` divides
`b` or vice-versa.

Any valuation ring induces a natural valuation on its fraction field, as we show in this file.
Namely, given the following instances:
`[comm_ring A] [is_domain A] [valuation_ring A] [field K] [algebra A K] [is_fraction_ring A K]`,
there is a natural valuation `valuation A K` on `K` with values in `value_group A K` where
the image of `A` under `algebra_map A K` agrees with `(valuation A K).integer`.

We also provide the equivalence of the following notions for a domain `R` in `valuation_ring.tfae`.
1. `R` is a valuation ring.
2. For each `x : fraction_ring K`, either `x` or `x⁻¹` is in `R`.
3. "divides" is a total relation on the elements of `R`.
4. "contains" is a total relation on the ideals of `R`.
5. `R` is a local bezout domain.

-/

universe u v w

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`cond] [] -/
/-- An integral domain is called a `valuation ring` provided that for any pair
of elements `a b : A`, either `a` divides `b` or vice versa. -/
class ValuationRing (A : Type u) [CommRing A] [IsDomain A] : Prop where
  cond : ∀ a b : A, ∃ c : A, a * c = b ∨ b * c = a
#align valuation_ring ValuationRing

namespace ValuationRing

section

variable (A : Type u) [CommRing A]

variable (K : Type v) [Field K] [Algebra A K]

/-- The value group of the valuation ring `A`. Note: this is actually a group with zero. -/
def ValueGroup : Type v :=
  Quotient (MulAction.orbitRel Aˣ K)
#align valuation_ring.value_group ValuationRing.ValueGroup

instance : Inhabited (ValueGroup A K) :=
  ⟨Quotient.mk'' 0⟩

instance : LE (ValueGroup A K) :=
  LE.mk fun x y =>
    Quotient.liftOn₂' x y (fun a b => ∃ c : A, c • b = a)
      (by
        rintro _ _ a b ⟨c, rfl⟩ ⟨d, rfl⟩; ext
        constructor
        · rintro ⟨e, he⟩
          use (c⁻¹ : Aˣ) * e * d
          apply_fun fun t => c⁻¹ • t  at he
          simpa [mul_smul] using he
        · rintro ⟨e, he⟩
          dsimp
          use (d⁻¹ : Aˣ) * c * e
          erw [← he, ← mul_smul, ← mul_smul]
          congr 1
          rw [mul_comm]
          simp only [← mul_assoc, ← Units.val_mul, mul_inv_self, one_mul])

instance : Zero (ValueGroup A K) :=
  ⟨Quotient.mk'' 0⟩

instance : One (ValueGroup A K) :=
  ⟨Quotient.mk'' 1⟩

instance : Mul (ValueGroup A K) :=
  Mul.mk fun x y =>
    Quotient.liftOn₂' x y (fun a b => Quotient.mk'' <| a * b)
      (by
        rintro _ _ a b ⟨c, rfl⟩ ⟨d, rfl⟩
        apply Quotient.sound'
        dsimp
        use c * d
        simp only [mul_smul, Algebra.smul_def, Units.smul_def, RingHom.map_mul, Units.val_mul]
        ring)

instance : Inv (ValueGroup A K) :=
  Inv.mk fun x =>
    Quotient.liftOn' x (fun a => Quotient.mk'' a⁻¹)
      (by
        rintro _ a ⟨b, rfl⟩
        apply Quotient.sound'
        use b⁻¹
        dsimp
        rw [Units.smul_def, Units.smul_def, Algebra.smul_def, Algebra.smul_def, mul_inv,
          map_units_inv])

variable [IsDomain A] [ValuationRing A] [IsFractionRing A K]

protected theorem le_total (a b : ValueGroup A K) : a ≤ b ∨ b ≤ a :=
  by
  rcases a with ⟨a⟩; rcases b with ⟨b⟩
  obtain ⟨xa, ya, hya, rfl⟩ : ∃ a b : A, _ := IsFractionRing.div_surjective a
  obtain ⟨xb, yb, hyb, rfl⟩ : ∃ a b : A, _ := IsFractionRing.div_surjective b
  have : (algebraMap A K) ya ≠ 0 := IsFractionRing.to_map_ne_zero_of_mem_nonZeroDivisors hya
  have : (algebraMap A K) yb ≠ 0 := IsFractionRing.to_map_ne_zero_of_mem_nonZeroDivisors hyb
  obtain ⟨c, h | h⟩ := ValuationRing.cond (xa * yb) (xb * ya)
  · right
    use c
    rw [Algebra.smul_def]
    field_simp
    simp only [← RingHom.map_mul, ← h]
    congr 1
    ring
  · left
    use c
    rw [Algebra.smul_def]
    field_simp
    simp only [← RingHom.map_mul, ← h]
    congr 1
    ring
#align valuation_ring.le_total ValuationRing.le_total

noncomputable instance : LinearOrderedCommGroupWithZero (ValueGroup A K) :=
  { (inferInstance : LE (ValueGroup A K)), (inferInstance : Mul (ValueGroup A K)),
    (inferInstance : Inv (ValueGroup A K)), (inferInstance : Zero (ValueGroup A K)),
    (inferInstance :
      One (ValueGroup A
          K)) with
    le_refl := by
      rintro ⟨⟩
      use 1
      rw [one_smul]
    le_trans := by
      rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ ⟨e, rfl⟩ ⟨f, rfl⟩
      use e * f
      rw [mul_smul]
    le_antisymm := by
      rintro ⟨a⟩ ⟨b⟩ ⟨e, rfl⟩ ⟨f, hf⟩
      by_cases hb : b = 0
      · simp [hb]
      have : IsUnit e := by
        apply isUnit_of_dvd_one
        use f
        rw [mul_comm]
        rw [← mul_smul, Algebra.smul_def] at hf
        nth_rw 2 [← one_mul b] at hf
        rw [← (algebraMap A K).map_one] at hf
        exact IsFractionRing.injective _ _ (mul_right_cancel₀ hb hf).symm
      apply Quotient.sound'
      use this.unit, rfl
    le_total := ValuationRing.le_total _ _
    decidableLe := by classical infer_instance
    mul_assoc := by
      rintro ⟨a⟩ ⟨b⟩ ⟨c⟩
      apply Quotient.sound'
      rw [mul_assoc]
      apply Setoid.refl'
    one_mul := by
      rintro ⟨a⟩
      apply Quotient.sound'
      rw [one_mul]
      apply Setoid.refl'
    mul_one := by
      rintro ⟨a⟩
      apply Quotient.sound'
      rw [mul_one]
      apply Setoid.refl'
    mul_comm := by
      rintro ⟨a⟩ ⟨b⟩
      apply Quotient.sound'
      rw [mul_comm]
      apply Setoid.refl'
    mul_le_mul_left := by
      rintro ⟨a⟩ ⟨b⟩ ⟨c, rfl⟩ ⟨d⟩
      use c; simp only [Algebra.smul_def]; ring
    zero_mul := by
      rintro ⟨a⟩
      apply Quotient.sound'
      rw [MulZeroClass.zero_mul]
      apply Setoid.refl'
    mul_zero := by
      rintro ⟨a⟩
      apply Quotient.sound'
      rw [MulZeroClass.mul_zero]
      apply Setoid.refl'
    zero_le_one := ⟨0, by rw [zero_smul]⟩
    exists_pair_ne := by
      use 0, 1
      intro c; obtain ⟨d, hd⟩ := Quotient.exact' c
      apply_fun fun t => d⁻¹ • t  at hd
      simpa using hd
    inv_zero := by
      apply Quotient.sound'
      rw [inv_zero]
      apply Setoid.refl'
    mul_inv_cancel := by
      rintro ⟨a⟩ ha
      apply Quotient.sound'
      use 1
      simp only [one_smul]
      apply (mul_inv_cancel _).symm
      contrapose ha
      simp only [Classical.not_not] at ha⊢
      rw [ha]; rfl }

/-- Any valuation ring induces a valuation on its fraction field. -/
def valuation : Valuation K (ValueGroup A K)
    where
  toFun := Quotient.mk''
  map_zero' := rfl
  map_one' := rfl
  map_mul' _ _ := rfl
  map_add_le_max' := by
    intro a b
    obtain ⟨xa, ya, hya, rfl⟩ : ∃ a b : A, _ := IsFractionRing.div_surjective a
    obtain ⟨xb, yb, hyb, rfl⟩ : ∃ a b : A, _ := IsFractionRing.div_surjective b
    have : (algebraMap A K) ya ≠ 0 := IsFractionRing.to_map_ne_zero_of_mem_nonZeroDivisors hya
    have : (algebraMap A K) yb ≠ 0 := IsFractionRing.to_map_ne_zero_of_mem_nonZeroDivisors hyb
    obtain ⟨c, h | h⟩ := ValuationRing.cond (xa * yb) (xb * ya)
    dsimp
    · apply le_trans _ (le_max_left _ _)
      use c + 1
      rw [Algebra.smul_def]
      field_simp
      simp only [← RingHom.map_mul, ← RingHom.map_add, ← (algebraMap A K).map_one, ← h]
      congr 1
      ring
    · apply le_trans _ (le_max_right _ _)
      use c + 1
      rw [Algebra.smul_def]
      field_simp
      simp only [← RingHom.map_mul, ← RingHom.map_add, ← (algebraMap A K).map_one, ← h]
      congr 1
      ring
#align valuation_ring.valuation ValuationRing.valuation

theorem mem_integer_iff (x : K) : x ∈ (valuation A K).integer ↔ ∃ a : A, algebraMap A K a = x :=
  by
  constructor
  · rintro ⟨c, rfl⟩
    use c
    rw [Algebra.smul_def, mul_one]
  · rintro ⟨c, rfl⟩
    use c
    rw [Algebra.smul_def, mul_one]
#align valuation_ring.mem_integer_iff ValuationRing.mem_integer_iff

/-- The valuation ring `A` is isomorphic to the ring of integers of its associated valuation. -/
noncomputable def equivInteger : A ≃+* (valuation A K).integer :=
  RingEquiv.ofBijective
    (show A →ₙ+* (valuation A K).integer from
      { toFun := fun a => ⟨algebraMap A K a, (mem_integer_iff _ _ _).mpr ⟨a, rfl⟩⟩
        map_mul' := fun _ _ => by
          ext1
          exact (algebraMap A K).map_mul _ _
        map_zero' := by
          ext1
          exact (algebraMap A K).map_zero
        map_add' := fun _ _ => by
          ext1
          exact (algebraMap A K).map_add _ _ })
    (by
      constructor
      · intro x y h
        apply_fun (coe : _ → K)  at h
        dsimp at h
        exact IsFractionRing.injective _ _ h
      · rintro ⟨a, ha : a ∈ (Valuation A K).integer⟩
        rw [mem_integer_iff] at ha
        obtain ⟨a, rfl⟩ := ha
        use a, rfl)
#align valuation_ring.equiv_integer ValuationRing.equivInteger

@[simp]
theorem coe_equivInteger_apply (a : A) : (equivInteger A K a : K) = algebraMap A K a :=
  rfl
#align valuation_ring.coe_equiv_integer_apply ValuationRing.coe_equivInteger_apply

theorem range_algebraMap_eq : (valuation A K).integer = (algebraMap A K).range :=
  by
  ext
  exact mem_integer_iff _ _ _
#align valuation_ring.range_algebra_map_eq ValuationRing.range_algebraMap_eq

end

section

variable (A : Type u) [CommRing A] [IsDomain A] [ValuationRing A]

instance (priority := 100) : LocalRing A :=
  LocalRing.of_isUnit_or_isUnit_one_sub_self
    (by
      intro a
      obtain ⟨c, h | h⟩ := ValuationRing.cond a (1 - a)
      · left
        apply isUnit_of_mul_eq_one _ (c + 1)
        simp [mul_add, h]
      · right
        apply isUnit_of_mul_eq_one _ (c + 1)
        simp [mul_add, h])

instance [DecidableRel ((· ≤ ·) : Ideal A → Ideal A → Prop)] : LinearOrder (Ideal A) :=
  {
    (inferInstance :
      CompleteLattice
        (Ideal
          A)) with
    le_total := by
      intro α β
      by_cases h : α ≤ β; · exact Or.inl h
      erw [not_forall] at h
      push_neg  at h
      obtain ⟨a, h₁, h₂⟩ := h
      right
      intro b hb
      obtain ⟨c, h | h⟩ := ValuationRing.cond a b
      · rw [← h]
        exact Ideal.mul_mem_right _ _ h₁
      · exfalso
        apply h₂
        rw [← h]
        apply Ideal.mul_mem_right _ _ hb
    decidableLe := inferInstance }

end

section

variable {R : Type _} [CommRing R] [IsDomain R] {K : Type _}

variable [Field K] [Algebra R K] [IsFractionRing R K]

theorem iff_dvd_total : ValuationRing R ↔ IsTotal R (· ∣ ·) := by
  classical
    refine' ⟨fun H => ⟨fun a b => _⟩, fun H => ⟨fun a b => _⟩⟩ <;> skip
    · obtain ⟨c, rfl | rfl⟩ := @ValuationRing.cond _ _ H a b <;> simp
    · obtain ⟨c, rfl⟩ | ⟨c, rfl⟩ := @IsTotal.total _ _ H a b <;> use c <;> simp
#align valuation_ring.iff_dvd_total ValuationRing.iff_dvd_total

theorem iff_ideal_total : ValuationRing R ↔ IsTotal (Ideal R) (· ≤ ·) := by
  classical
    refine' ⟨fun _ => ⟨le_total⟩, fun H => iff_dvd_total.mpr ⟨fun a b => _⟩⟩
    have := @IsTotal.total _ _ H (Ideal.span {a}) (Ideal.span {b})
    simp_rw [Ideal.span_singleton_le_span_singleton] at this
    exact this.symm
#align valuation_ring.iff_ideal_total ValuationRing.iff_ideal_total

variable {R} (K)

theorem dvd_total [h : ValuationRing R] (x y : R) : x ∣ y ∨ y ∣ x :=
  @IsTotal.total _ (iff_dvd_total.mp h) x y
#align valuation_ring.dvd_total ValuationRing.dvd_total

theorem unique_irreducible [ValuationRing R] ⦃p q : R⦄ (hp : Irreducible p) (hq : Irreducible q) :
    Associated p q := by
  have := dvd_total p q
  rw [Irreducible.dvd_comm hp hq, or_self_iff] at this
  exact associated_of_dvd_dvd (Irreducible.dvd_symm hq hp this) this
#align valuation_ring.unique_irreducible ValuationRing.unique_irreducible

variable (R)

theorem iff_isInteger_or_isInteger :
    ValuationRing R ↔ ∀ x : K, IsLocalization.IsInteger R x ∨ IsLocalization.IsInteger R x⁻¹ :=
  by
  constructor
  · intro H x
    obtain ⟨x : R, y, hy, rfl⟩ := IsFractionRing.div_surjective x
    any_goals infer_instance
    have := (map_ne_zero_iff _ (IsFractionRing.injective R K)).mpr (nonZeroDivisors.ne_zero hy)
    obtain ⟨s, rfl | rfl⟩ := ValuationRing.cond x y
    ·
      exact
        Or.inr
          ⟨s, eq_inv_of_mul_eq_one_left <| by rwa [mul_div, div_eq_one_iff_eq, map_mul, mul_comm]⟩
    · exact Or.inl ⟨s, by rwa [eq_div_iff, map_mul, mul_comm]⟩
  · intro H
    constructor
    intro a b
    by_cases ha : a = 0
    · subst ha
      exact ⟨0, Or.inr <| MulZeroClass.mul_zero b⟩
    by_cases hb : b = 0
    · subst hb
      exact ⟨0, Or.inl <| MulZeroClass.mul_zero a⟩
    replace ha := (map_ne_zero_iff _ (IsFractionRing.injective R K)).mpr ha
    replace hb := (map_ne_zero_iff _ (IsFractionRing.injective R K)).mpr hb
    obtain ⟨c, e⟩ | ⟨c, e⟩ := H (algebraMap R K a / algebraMap R K b)
    · rw [eq_div_iff hb, ← map_mul, (IsFractionRing.injective R K).eq_iff, mul_comm] at e
      exact ⟨c, Or.inr e⟩
    · rw [inv_div, eq_div_iff ha, ← map_mul, (IsFractionRing.injective R K).eq_iff, mul_comm c] at e
      exact ⟨c, Or.inl e⟩
#align valuation_ring.iff_is_integer_or_is_integer ValuationRing.iff_isInteger_or_isInteger

variable {K}

theorem isInteger_or_isInteger [h : ValuationRing R] (x : K) :
    IsLocalization.IsInteger R x ∨ IsLocalization.IsInteger R x⁻¹ :=
  (iff_isInteger_or_isInteger R K).mp h x
#align valuation_ring.is_integer_or_is_integer ValuationRing.isInteger_or_isInteger

variable {R}

-- This implies that valuation rings are integrally closed through typeclass search.
instance (priority := 100) [ValuationRing R] : IsBezout R := by
  classical
    rw [IsBezout.iff_span_pair_isPrincipal]
    intro x y
    rw [Ideal.span_insert]
    cases le_total (Ideal.span {x} : Ideal R) (Ideal.span {y})
    · erw [sup_eq_right.mpr h]
      exact ⟨⟨_, rfl⟩⟩
    · erw [sup_eq_left.mpr h]
      exact ⟨⟨_, rfl⟩⟩

theorem iff_local_bezout_domain : ValuationRing R ↔ LocalRing R ∧ IsBezout R := by
  classical
    refine' ⟨fun H => ⟨inferInstance, inferInstance⟩, _⟩
    rintro ⟨h₁, h₂⟩
    skip
    refine' iff_dvd_total.mpr ⟨fun a b => _⟩
    obtain ⟨g, e : _ = Ideal.span _⟩ := IsBezout.span_pair_isPrincipal a b
    obtain ⟨a, rfl⟩ :=
      ideal.mem_span_singleton'.mp
        (show a ∈ Ideal.span {g} by
          rw [← e]
          exact Ideal.subset_span (by simp))
    obtain ⟨b, rfl⟩ :=
      ideal.mem_span_singleton'.mp
        (show b ∈ Ideal.span {g} by
          rw [← e]
          exact Ideal.subset_span (by simp))
    obtain ⟨x, y, e'⟩ :=
      ideal.mem_span_pair.mp
        (show g ∈ Ideal.span {a * g, b * g} by
          rw [e]
          exact Ideal.subset_span (by simp))
    cases' eq_or_ne g 0 with h h
    · simp [h]
    have : x * a + y * b = 1 := by
      apply mul_left_injective₀ h
      convert e' <;> ring_nf
    cases' LocalRing.isUnit_or_isUnit_of_add_one this with h' h'
    left
    swap
    right
    all_goals
      exact mul_dvd_mul_right (is_unit_iff_forall_dvd.mp (isUnit_of_mul_isUnit_right h') _) _
#align valuation_ring.iff_local_bezout_domain ValuationRing.iff_local_bezout_domain

protected theorem tFAE (R : Type u) [CommRing R] [IsDomain R] :
    TFAE
      [ValuationRing R,
        ∀ x : FractionRing R, IsLocalization.IsInteger R x ∨ IsLocalization.IsInteger R x⁻¹,
        IsTotal R (· ∣ ·), IsTotal (Ideal R) (· ≤ ·), LocalRing R ∧ IsBezout R] :=
  by
  tfae_have 1 ↔ 2; · exact iff_is_integer_or_is_integer R _
  tfae_have 1 ↔ 3; · exact iff_dvd_total
  tfae_have 1 ↔ 4; · exact iff_ideal_total
  tfae_have 1 ↔ 5; · exact iff_local_bezout_domain
  tfae_finish
#align valuation_ring.tfae ValuationRing.tFAE

end

theorem Function.Surjective.valuationRing {R S : Type _} [CommRing R] [IsDomain R] [ValuationRing R]
    [CommRing S] [IsDomain S] (f : R →+* S) (hf : Function.Surjective f) : ValuationRing S :=
  ⟨fun a b => by
    obtain ⟨⟨a, rfl⟩, ⟨b, rfl⟩⟩ := hf a, hf b
    obtain ⟨c, rfl | rfl⟩ := ValuationRing.cond a b
    exacts[⟨f c, Or.inl <| (map_mul _ _ _).symm⟩, ⟨f c, Or.inr <| (map_mul _ _ _).symm⟩]⟩
#align function.surjective.valuation_ring Function.Surjective.valuationRing

section

variable {𝒪 : Type u} {K : Type v} {Γ : Type w} [CommRing 𝒪] [IsDomain 𝒪] [Field K] [Algebra 𝒪 K]
  [LinearOrderedCommGroupWithZero Γ] (v : Valuation K Γ) (hh : v.Integers 𝒪)

include hh

/-- If `𝒪` satisfies `v.integers 𝒪` where `v` is a valuation on a field, then `𝒪`
is a valuation ring. -/
theorem of_integers : ValuationRing 𝒪 := by
  constructor
  intro a b
  cases le_total (v (algebraMap 𝒪 K a)) (v (algebraMap 𝒪 K b))
  · obtain ⟨c, hc⟩ := Valuation.Integers.dvd_of_le hh h
    use c
    exact Or.inr hc.symm
  · obtain ⟨c, hc⟩ := Valuation.Integers.dvd_of_le hh h
    use c
    exact Or.inl hc.symm
#align valuation_ring.of_integers ValuationRing.of_integers

end

section

variable (K : Type u) [Field K]

/-- A field is a valuation ring. -/
instance (priority := 100) of_field : ValuationRing K :=
  by
  constructor
  intro a b
  by_cases b = 0
  · use 0
    left
    simp [h]
  · use a * b⁻¹
    right
    field_simp
    rw [mul_comm]
#align valuation_ring.of_field ValuationRing.of_field

end

section

variable (A : Type u) [CommRing A] [IsDomain A] [DiscreteValuationRing A]

/-- A DVR is a valuation ring. -/
instance (priority := 100) of_discreteValuationRing : ValuationRing A :=
  by
  constructor
  intro a b
  by_cases ha : a = 0;
  · use 0
    right
    simp [ha]
  by_cases hb : b = 0;
  · use 0
    left
    simp [hb]
  obtain ⟨ϖ, hϖ⟩ := DiscreteValuationRing.exists_irreducible A
  obtain ⟨m, u, rfl⟩ := DiscreteValuationRing.eq_unit_mul_pow_irreducible ha hϖ
  obtain ⟨n, v, rfl⟩ := DiscreteValuationRing.eq_unit_mul_pow_irreducible hb hϖ
  cases' le_total m n with h h
  · use (u⁻¹ * v : Aˣ) * ϖ ^ (n - m)
    left
    simp_rw [mul_comm (u : A), Units.val_mul, ← mul_assoc, mul_assoc _ (u : A)]
    simp only [Units.mul_inv, mul_one, mul_comm _ (v : A), mul_assoc, ← pow_add]
    congr 2
    linarith
  · use (v⁻¹ * u : Aˣ) * ϖ ^ (m - n)
    right
    simp_rw [mul_comm (v : A), Units.val_mul, ← mul_assoc, mul_assoc _ (v : A)]
    simp only [Units.mul_inv, mul_one, mul_comm _ (u : A), mul_assoc, ← pow_add]
    congr 2
    linarith
#align valuation_ring.of_discrete_valuation_ring ValuationRing.of_discreteValuationRing

end

end ValuationRing


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import analysis.normed_space.bounded_linear_maps
import from_mathlib.seminorm_from_bounded
import from_mathlib.smoothing_seminorm

/-!
# Basis.norm

In this file, we prove [BGR, Lemma 3.2.1./3]: if `K` is a normed field with a nonarchimedean
power-multiplicative norm and `L/K` is a finite extension, then there exists at least one
power-multiplicative `K`-algebra norm on `L` extending the norm on `K`.

## Main Definitions
* `basis.norm` : the function sending an element `x : L` to the maximum of the norms of its
  coefficients with respect to the `K`-basis `B` of `L`.

## Main Results
* `finite_extension_pow_mul_seminorm` : the proof of [BGR, Lemma 3.2.1./3].

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

basis.norm, nonarchimedean
-/

noncomputable theory

open finset

open_locale big_operators

section continuous

/-- A continuous linear map between normed spaces. -/
structure is_continuous_linear_map (𝕜 : Type*) [normed_field 𝕜]
  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
  {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] (f : E → F)
  extends is_linear_map 𝕜 f : Prop :=
(cont : continuous f . tactic.interactive.continuity')

/-- A linear map between normed spaces is continuous if and only if it is bounded,-/
lemma is_continuous_linear_map_iff_is_bounded_linear_map {K : Type*} [nontrivially_normed_field K]
  {M : Type*} [normed_add_comm_group M] [normed_space K M] {N : Type*} [normed_add_comm_group N]
  [normed_space K N] (f : M → N) : is_continuous_linear_map K f ↔ is_bounded_linear_map K f :=
begin
  refine ⟨λ h_cont, _, λ h_bdd, ⟨h_bdd.to_is_linear_map, h_bdd.continuous⟩⟩,
  { set F : M →L[K] N :=
    by use [f, is_linear_map.map_add h_cont.1, is_linear_map.map_smul h_cont.1, h_cont.2],
    exact continuous_linear_map.is_bounded_linear_map F, },
end

end continuous

section finsum

/-- Given a function `f : α → M` and a linear equivalence `g : M ≃ₛₗ[σ] N`, we have
  `g ∑ᶠ f i = ∑ᶠ g(f i)`.  -/
theorem linear_equiv.map_finsum {R S : Type*} {α : Sort*} [semiring R] [semiring S] (σ : R →+* S)
  {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] (M N : Type*) [add_comm_monoid M]
  [add_comm_monoid N] [module R M] [module S N] (g : M ≃ₛₗ[σ] N) (f : α → M) :
  g (finsum (λ (i : α), f i)) = finsum (λ (i : α), g (f i)) :=
add_equiv.map_finsum g.to_add_equiv f

/-- Given a fintype `α`, a function `f : α → M` and a linear equivalence `g : M ≃ₛₗ[σ] N`, we have
  `g (∑ (i : α), f i) = ∑ (i : α), g (f i)`.  -/
theorem linear_equiv.map_finset_sum {R S : Type*} {α : Sort*} [fintype α] [semiring R] [semiring S]
  (σ : R →+* S) {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] (M N : Type*)
  [add_comm_monoid M] [add_comm_monoid N] [module R M] [module S N] (g : M ≃ₛₗ[σ] N)
  (f : α → M) : g (∑ (i : α), f i) = ∑ (i : α), g (f i) :=
by simp only [← finsum_eq_sum_of_fintype, linear_equiv.map_finsum]

theorem finsum_apply {α : Type*} {β : α → Type*} {γ : Type*} [finite γ]
  [Π (a : α), add_comm_monoid (β a)] (a : α) (g : γ → Π (a : α), β a) :
  finsum (λ (c : γ), g c) a = finsum (λ (c : γ), g c a) :=
begin
  casesI nonempty_fintype γ,
  simp only [finsum_eq_sum_of_fintype, sum_apply]
end

/-- If `∑ i, f i • v i = ∑ i, g i • v i`, then for all `i`, `f i = g i`. -/
lemma linear_independent.eq_coords_of_eq {R : Type*} [ring R] {M : Type*} [add_comm_group M]
  [module R M] {ι : Type*} [fintype ι] {v : ι → M} (hv : linear_independent R v) {f : ι → R}
  {g : ι → R} (heq : ∑ i, f i • v i = ∑ i, g i • v i) (i : ι) : f i = g i :=
begin
  rw [← sub_eq_zero, ← sum_sub_distrib] at heq,
  simp_rw ← sub_smul at heq,
  rw linear_independent_iff' at hv,
  exact sub_eq_zero.mp (hv univ (λ i, (f i - g i)) heq i (mem_univ i)),
end

end finsum

variables {K : Type*} [normed_field K] {L : Type*} [field L] [algebra K L]

/-- If `B` is a basis of the `K`-vector space `L` such that `B i = 1` for some index `i`, then
each `k:K` gets represented as `k • B i` as an element of `L`. -/
lemma basis_one {ι : Type*} [fintype ι] [decidable_eq ι] {B : basis ι K L} {i : ι}
  (hBi : B i = (1 : L)) (k : K) :
  B.equiv_fun ((algebra_map K L) k) = λ (j : ι), if (j = i) then k else 0 :=
begin
  ext j,
  apply linear_independent.eq_coords_of_eq B.linear_independent,
  rw basis.sum_equiv_fun B (algebra_map K L k),
  have h_sum : ∑ (j : ι), ite (j = i) k 0 • B j = ∑ (j : ι), ite (j = i) (k • B j) 0,
  { apply sum_congr (eq.refl _),
    { rintros h -,
      split_ifs,
      exacts [rfl, zero_smul _ _] }},
  rw [h_sum, algebra.algebra_map_eq_smul_one, sum_ite_eq' univ (i : ι) (λ j : ι, k • B j)],
  simp only [mem_univ, if_true, hBi],
end

namespace basis

/-- The function sending an element `x : L` to the maximum of the norms of its coefficients
  with respect to the `K`-basis `B` of `L`.-/
def norm {ι : Type*} [fintype ι] [nonempty ι] (B : basis ι K L) : L → ℝ :=
λ x, ‖B.equiv_fun x (classical.some (finite.exists_max (λ i : ι, ‖B.equiv_fun x i‖ )))‖

/-- The norm of a coefficient `x_i` is less than or equal to the norm of `x`. -/
lemma le_norm {ι : Type*} [fintype ι] [nonempty ι] (B : basis ι K L) (x : L) (i : ι) :
  ‖B.equiv_fun x i‖ ≤ B.norm x :=
classical.some_spec (finite.exists_max (λ i : ι, ‖B.equiv_fun x i‖)) i

/-- For any `K`-basis of `L`, we have `B.norm 0 = 0`. -/
lemma norm_zero' {ι : Type*} [fintype ι] [nonempty ι] (B : basis ι K L) :  B.norm 0 = 0 :=
by simp only [norm, map_zero, pi.zero_apply, norm_zero]

/-- For any `K`-basis of `L`, and any `x : L`, we have `B.norm (-x) = B.norm x`. -/
lemma norm_neg {ι : Type*} [fintype ι] [nonempty ι] (B : basis ι K L) (x : L) :
  B.norm (-x) = B.norm x :=
begin
  simp only [norm, map_neg],
  convert norm_neg _,
  ext x, simp only [pi.neg_apply, norm_neg]
end

/-- For any `K`-basis of `L`, `B.norm` extends the norm on `K`. -/
lemma norm_extends {ι : Type*} [fintype ι] [nonempty ι] {B : basis ι K L}
  {i : ι} (hBi : B i = (1 : L)) :
  function_extends (λ x : K, ‖x‖) B.norm :=
begin
  classical,
  intro k,
  { by_cases hk : k = 0,
  { simp only [hk, map_zero, norm_zero, norm_zero'] },
  { simp only [norm, basis_one hBi],
    have h_max : (classical.some (finite.exists_max (λ j : ι,
      ‖(λ (n : ι), if (n = i) then k else 0) j ‖))) = i,
    { by_contradiction h,
      have h_max := classical.some_spec (finite.exists_max (λ j : ι,
        ‖(λ (n : ι), if (n = i) then k else 0) j ‖)),
      simp only [if_neg h] at h_max,
      specialize h_max i,
      rw [if_pos rfl, norm_zero, norm_le_zero_iff] at h_max,
      exact hk h_max },
    rw if_pos h_max }}
end

/-- For any `K`-basis of `L`, if the norm on `K` is nonarchimedean, then so is `B.norm`. -/
lemma norm_is_nonarchimedean {ι : Type*} [fintype ι] [nonempty ι] {B : basis ι K L}
  (hna : is_nonarchimedean (has_norm.norm : K → ℝ)) : is_nonarchimedean B.norm  :=
begin
  classical,
  intros x y,
  simp only [basis.norm],
  set ixy := classical.some (finite.exists_max (λ i : ι, ‖B.equiv_fun (x + y) i‖)) with hixy_def,
  have hxy : ‖B.equiv_fun (x + y) ixy‖ ≤ max (‖B.equiv_fun x ixy‖) (‖B.equiv_fun y ixy‖),
  { rw [linear_equiv.map_add, pi.add_apply], exact hna _ _ },
  have hix := classical.some_spec (finite.exists_max (λ i : ι, ‖B.equiv_fun x i‖)),
  have hiy := classical.some_spec (finite.exists_max (λ i : ι, ‖B.equiv_fun y i‖)),
  cases le_max_iff.mp hxy with hx hy,
  { apply le_max_of_le_left (le_trans hx (hix ixy)) },
  { apply le_max_of_le_right (le_trans hy (hiy ixy)) },
end

/-- For any `K`-basis of `L`, `B.norm` is bounded with respect to multiplication. That is,
  `∃ (c : ℝ), c > 0` such that ` ∀ (x y : L), B.norm (x * y) ≤ c * B.norm x * B.norm y`. -/
lemma norm_is_bdd {ι : Type*} [fintype ι] [nonempty ι] {B : basis ι K L} {i : ι}
  (hBi : B i = (1 : L)) (hna : is_nonarchimedean (has_norm.norm : K → ℝ)) :
  ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : L), B.norm (x * y) ≤ c * B.norm x * B.norm y :=
begin
  classical,
  -- The bounding constant `c` will be the maximum of the products `B.norm (B i * B j)`.
  set c := classical.some (finite.exists_max (λ (i : ι × ι), B.norm (B i.1 * B i.2))) with hc_def,
  have hc := classical.some_spec (finite.exists_max (λ (i : ι × ι), B.norm (B i.1 * B i.2))),
  use B.norm (B c.1 * B c.2),
  split,
  -- `B c.1 * B c.2` is positive
  {  have h_pos : (0 : ℝ) < B.norm (B i * B i),
    { have h1 : (1 : L) = (algebra_map K L) 1 := by rw map_one,
      rw [hBi, mul_one, h1, basis.norm_extends hBi],
      simp only [norm_one, zero_lt_one] },
    exact lt_of_lt_of_le h_pos (hc (i, i)) },
  -- ∀ (x y : L), B.norm (x * y) ≤ B.norm (⇑B c.fst * ⇑B c.snd) * B.norm x * B.norm y
  { intros x y,
    -- `ixy` is an index for which `‖B.equiv_fun (x*y) i‖` is maximum.
    set ixy := classical.some (finite.exists_max (λ i : ι, ‖B.equiv_fun (x*y) i‖)) with hixy_def,
    -- We rewrite the LHS using `ixy`.
    conv_lhs{ simp only [basis.norm],
      rw [← hixy_def, ← basis.sum_equiv_fun B x, ← basis.sum_equiv_fun B y] },
    rw [sum_mul, linear_equiv.map_finset_sum, sum_apply],
    simp_rw [smul_mul_assoc, linear_equiv.map_smul, mul_sum,
      linear_equiv.map_finset_sum, mul_smul_comm, linear_equiv.map_smul],
    /- Since the norm is nonarchimidean, the norm of a finite sum is bounded by the maximum of the
      norms of the summands. -/
    have hna' : is_nonarchimedean (normed_field.to_mul_ring_norm K) := hna,
    have hk : ∃ (k : ι) (hk : univ.nonempty → k ∈ univ),
     ‖∑ (i : ι),
       (B.equiv_fun x i • ∑ (i_1 : ι), B.equiv_fun y i_1 • B.equiv_fun (B i * B i_1)) ixy‖ ≤
     ‖ (B.equiv_fun x k • ∑ (j : ι),  B.equiv_fun y j • B.equiv_fun (B k * B j)) ixy‖ :=
    is_nonarchimedean_finset_image_add hna'
        (λ i, (B.equiv_fun x i • ∑ (i_1 : ι), B.equiv_fun y i_1 • B.equiv_fun (B i * B i_1)) ixy)
        (univ : finset ι),
    obtain ⟨k, -, hk⟩ := hk,
    apply le_trans hk,
    -- We use the above property again.
    have hk' :  ∃ (k' : ι) (hk' : univ.nonempty → k' ∈ univ),
      ‖∑ (j : ι), B.equiv_fun y j • B.equiv_fun (B k * B j) ixy‖ ≤
      ‖B.equiv_fun y k' • B.equiv_fun (B k * B k') ixy‖ :=
    is_nonarchimedean_finset_image_add hna'
      (λ i, B.equiv_fun y i • B.equiv_fun (B k * B i) ixy) (univ : finset ι),
    obtain ⟨k', -, hk'⟩ := hk',
    rw [pi.smul_apply, norm_smul, sum_apply],
    apply le_trans (mul_le_mul_of_nonneg_left hk' (norm_nonneg _)),
    -- Now an easy computation leads to the desired conclusion.
    rw [norm_smul, mul_assoc, mul_comm (B.norm (B c.fst * B c.snd)), ← mul_assoc],
    exact mul_le_mul (mul_le_mul (B.le_norm _ _) (B.le_norm _ _) (norm_nonneg _) (norm_nonneg _))
      (le_trans (B.le_norm _ _) (hc (k, k'))) (norm_nonneg _)
      (mul_nonneg (norm_nonneg _) (norm_nonneg _)) }
end

/-- For any `k : K`, `y : L`, we have
  `B.equiv_fun ((algebra_map K L k) * y) i = k * (B.equiv_fun y i) `. -/
lemma repr_smul {ι : Type*} [fintype ι] (B : basis ι K L) (i : ι) (k : K) (y : L) :
  B.equiv_fun ((algebra_map K L k) * y) i = k * (B.equiv_fun y i) :=
by rw [← smul_eq_mul, algebra_map_smul, linear_equiv.map_smul]; refl

/-- For any `k : K`, `y : L`, we have
  `B.norm ((algebra_map K L) k * y) = B.norm ((algebra_map K L) k) * B.norm y`. -/
lemma norm_smul {ι : Type*} [fintype ι] [nonempty ι] {B : basis ι K L}
  {i : ι} (hBi : B i = (1 : L)) (k : K) (y : L) :
  B.norm ((algebra_map K L) k * y) = B.norm ((algebra_map K L) k) * B.norm y :=
begin
  classical,
  by_cases hk : k = 0,
  { rw [hk, map_zero, zero_mul, B.norm_zero', zero_mul],},
  { rw norm_extends hBi,
    simp only [norm],
    set i := classical.some (finite.exists_max (λ i : ι, ‖B.equiv_fun y i‖)) with hi_def,
    have hi := classical.some_spec (finite.exists_max (λ i : ι, ‖B.equiv_fun y i‖)),
    set j := classical.some (finite.exists_max (λ i : ι, ‖B.equiv_fun ((algebra_map K L) k * y) i‖))
      with hj_def,
    have hj := classical.some_spec
      (finite.exists_max (λ i : ι, ‖B.equiv_fun ((algebra_map K L) k * y) i‖)),
    have hij : ‖B.equiv_fun y i‖ = ‖B.equiv_fun y j‖,
    { refine le_antisymm _ (hi j),
      { specialize hj i,
        rw ← hj_def at hj,
        simp only [repr_smul, norm_mul] at hj,
        exact (mul_le_mul_left (lt_of_le_of_ne (norm_nonneg _)
          (ne.symm (norm_ne_zero_iff.mpr hk)))).mp hj }},
    rw [repr_smul, norm_mul, ← hi_def, ← hj_def, hij] },
end

end basis

/-- If `K` is a nonarchimedean normed field `L/K` is a finite extension, then there exists a
power-multiplicative nonarchimedean `K`-algebra norm on `L` extending the norm on `K`. -/
lemma finite_extension_pow_mul_seminorm (hfd : finite_dimensional K L)
  (hna : is_nonarchimedean (norm : K → ℝ)) :
  ∃ (f : algebra_norm K L), is_pow_mul f ∧ function_extends (norm : K → ℝ) f ∧
    is_nonarchimedean f :=
begin
  -- Choose a basis B = {1, e2,..., en} of the K-vector space L
  classical,
  set h1 : linear_independent K (λ (x : ({1} : set L)), (x : L)) :=
  linear_independent_singleton one_ne_zero,
  set ι := {x // x ∈ (h1.extend (set.subset_univ ({1} : set L)))} with hι,
  set B : basis ι K L  := basis.extend h1 with hB,
  letI hfin : fintype ι := finite_dimensional.fintype_basis_index B,
  haveI hem : nonempty ι := B.index_nonempty,
  have h1L : (1 : L) ∈ h1.extend _ := basis.subset_extend _ (set.mem_singleton (1 : L)),
  have hB1 : B ⟨1, h1L⟩ = (1 : L),
  { rw [basis.coe_extend, subtype.coe_mk] },
  -- For every k ∈ K, k = k • 1 + 0 • e2 + ... + 0 • en
  have h_k : ∀ (k : K), B.equiv_fun ((algebra_map K L) k) = λ (i : ι),
    if (i = ⟨(1 : L), h1L⟩) then k else 0 := basis_one hB1,
  -- Define a function g : L → ℝ by setting g (∑ki • ei) = maxᵢ ‖ ki ‖
  set g : L → ℝ := B.norm with hg,
  -- g 0 = 0
  have hg0 : g 0 = 0 := B.norm_zero',
  -- g takes nonnegative values
  have hg_nonneg : ∀ (x : L), 0 ≤ g x := λ x, norm_nonneg _,
  -- g extends the norm on K
  have hg_ext : function_extends (norm : K → ℝ) g := basis.norm_extends hB1,
  -- g is nonarchimedean
  have hg_na : is_nonarchimedean g := basis.norm_is_nonarchimedean hna,
  -- g satisfies the triangle inequality
  have hg_add : ∀ (a b : L), g (a + b) ≤ g a + g b,
  { exact add_le_of_is_nonarchimedean hg_nonneg hg_na },
  -- g (-a) = g a
  have hg_neg : ∀ (a : L), g (-a) = g a := B.norm_neg,
  -- g is multiplicatively bounded
  have hg_bdd : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : L), g (x * y) ≤ c * g x * g y,
  { exact basis.norm_is_bdd hB1 hna },
  -- g is a K-module norm
  have hg_mul : ∀ (k : K) (y : L), g ((algebra_map K L) k * y) = g ((algebra_map K L) k) * g y :=
  λ k y, basis.norm_smul hB1 k y,
  -- Using BGR Prop. 1.2.1/2, we can smooth g to a ring norm f on L that extends the norm on K.
  set f := seminorm_from_bounded hg0 hg_nonneg hg_bdd hg_add hg_neg with hf,
  have hf_na : is_nonarchimedean f :=
  seminorm_from_bounded_is_nonarchimedean hg_nonneg hg_bdd hg_na,
  have hf_1 : f 1 ≤ 1 := seminorm_from_bounded_is_norm_le_one_class hg_nonneg hg_bdd,
  have hf_ext : function_extends (norm : K → ℝ) f,
  { intro k,
    rw ← hg_ext,
    exact seminorm_from_bounded_of_mul_apply hg_nonneg hg_bdd (hg_mul k) },
  -- Using BGR Prop. 1.3.2/1, we obtain from f  a power multiplicative K-algebra norm on L
  -- extending the norm on K.
  set F' := smoothing_seminorm f hf_1 hf_na with hF',
  have hF'_ext : ∀ k : K,  F' ((algebra_map K L) k) = ‖k‖,
  { intro k,
    rw ← hf_ext _,
    exact smoothing_seminorm_apply_of_is_mul f hf_1 hf_na
      (seminorm_from_bounded_of_mul_is_mul hg_nonneg hg_bdd (hg_mul k)) },
  have hF'_1 : F' 1 = 1,
  { have h1 : (1 : L) = (algebra_map K L) 1 := by rw map_one,
    simp only [h1, hF'_ext (1 : K), norm_one], },
  have hF'_0 : F' ≠ 0 := fun_like.ne_iff.mpr ⟨(1 : L), by {rw hF'_1, exact one_ne_zero}⟩,

  set F : algebra_norm K L :=
  { smul' :=  λ k y,
    begin
      simp only [ring_norm.to_fun_eq_coe],
      have hk : ∀ y : L, f ((algebra_map K L k) * y) = f (algebra_map K L k) * f y,
      { exact seminorm_from_bounded_of_mul_is_mul hg_nonneg hg_bdd (hg_mul k), },
      have hfk : ‖k‖  = (smoothing_seminorm f hf_1 hf_na)((algebra_map K L) k),
      { rw [← hf_ext k, eq_comm, smoothing_seminorm_apply_of_is_mul f hf_1 hf_na hk] },
      simp only [hfk, hF'],
      erw [← smoothing_seminorm_of_mul f hf_1 hf_na hk y, algebra.smul_def],
      refl,
    end,
    ..(ring_seminorm.to_ring_norm F' hF'_0) },

    have hF_ext : ∀ k : K,  F ((algebra_map K L) k) = ‖k‖,
    { intro k,
      rw ← hf_ext _,
      exact smoothing_seminorm_apply_of_is_mul f hf_1 hf_na
        (seminorm_from_bounded_of_mul_is_mul hg_nonneg hg_bdd (hg_mul k)) },
    have hF_1 : F 1 = 1,
    { have h1 : (1 : L) = (algebra_map K L) 1 := by rw map_one,
      simp only [h1, hF_ext (1 : K), norm_one], },
    exact ⟨F, smoothing_seminorm_is_pow_mul f hf_1, hF_ext,
      smoothing_seminorm_is_nonarchimedean f hf_1 hf_na⟩,
end


-- Copyright (C) 2020 by @ljt12138

import tactic pal.basics pal.proof

namespace pal_logic

lemma mp_conseq {α agent : Type} {φ ψ : sentence α agent} :
  ⊨ φ ↣ ψ → ⊨ φ → ⊨ ψ :=
begin
  intros a₁ a₂, simp at *,
  intros, apply a₁, apply a₂
end

lemma conjunction_truth {α agent W : Type} (Γ : list (sentence α agent))
  (M : worlds α agent W) (s : W) : (M, s) ⊨ conjunction Γ ↔ ∀ φ, φ ∈ Γ → (M, s) ⊨ φ :=
begin
  split,
  {
    intros a, induction Γ with φ Γ ih,
    simp, simp at *,
    cases Γ, { simp at *, assumption },
    split, simp at *,
    classical, by_contra, apply a, intros, apply a_1, exact a_2,
    intros φ h,
    apply ih, classical, by_contra, apply a, intros, simp, intro, exact a_1,
    exact h
  },
  {
    intros a, induction Γ with φ Γ ih,
    simp, simp at *,
    cases Γ, { simp at *, assumption },
    intros a₁,
    apply a₁, exact a.left, apply ih, exact a.right
  }
end

theorem soundness {α agent : Type} (φ : sentence α agent) :
  ⊢ φ → ⊨ φ :=
begin
  intros, cases a with pf a,
  induction a,
  case ax1 {
    unfold Ax1, simp, intros, assumption
  },
  case ax2 {
    unfold Ax2, simp, intros, exact a a_2 (a_1 a_2)
  },
  case ax3 {
    unfold Ax3, simp, intros, classical, tauto
  },
  case ax4 {
    unfold Ax4, simp, intros, exact a _ a_2 (a_1 _ a_2)
  },
  case ref {
    unfold AxR, simp, intros, apply a s,
    have ht := M.equiv a_i,
    unfold equivalence at ht,
    exact ht.left s
  },
  case trans {
    unfold AxT, simp, intros, apply a,
    have ht := M.equiv a_i,
    unfold equivalence at ht,
    apply ht.right.right, assumption, assumption
  },
  case sym {
    unfold AxS, simp, intros W M s a₁ t a₂ a₃,
    have a₄ := not_forall.mp a₁,
    cases a₄ with x h,
    apply h,intros h₁, apply a₃,
    have ht := M.equiv a_i, unfold equivalence at ht,
    apply ht.right.right,
    { apply ht.right.left, assumption },
    { assumption }
  },
  case mp {
    apply mp_conseq, assumption, assumption
  },
  case truth {
    simp at *, intros,
    apply a_ih
  },
  case conj {
    simp at *, intros W M s a₁,
    have h₁ := (conjunction_truth a_Γ₂ M s).mp a₁,
    apply a_ih W M s,
    apply (conjunction_truth _ _ _).mpr,
    intros, apply h₁, exact a_h a
  },
  case ax2' { unfold Ax2', simp, intros, exact a_2 a_1 },
  case ax3' { unfold Ax3', simp, intros, classical, tauto },
  repeat { simp at *, intros, classical, tauto },
  case curry {
    simp at *, intros,  apply a_ih, intros contra,
    exact contra a a_1
  }
end

end pal_logic


import data.real.basic
import data.fin.basic
import summation
import algebra.big_operators.ring
import summation

variables {d n : ℕ} {hdzero : d ≠ 0}

open_locale big_operators

-- ∀ j ≤ d, ∑ (i < j), x i ≤ ∑ (i < j), y i
def majorizes_le (x y : fin d → ℝ) : Prop :=
  ∀ j ≤ d, ∑ i : (fin j), x (fin.cast_le H i) ≤ ∑ i : (fin j), y (fin.cast_le H i)

-- ∑ (i < d), x i = ∑ (i < d), y i
def majorizes_eq (x y : fin d → ℝ) : Prop :=
  ∑ i : fin d, x i = ∑ i : fin d, y i

def majorizes (x y : fin d → ℝ ) : Prop :=
  majorizes_le x y ∧ majorizes_eq x y

-- T x y := ∑ (j < d), j • (x j - y j)
def T (x y : fin d → ℝ) : ℝ :=
  ∑ j : fin d, (j.val + 1) • (y j - x j)

lemma T_apply' [has_zero (fin (d + 1))] {x y : fin (d + 1) → ℝ} : T x y = ∑ j i : fin (d + 1), ite (i ≤ j) (y j - x j) 0 :=
begin
  rw T,
  congr,
  ext j,
  rw finset.sum_ite,
  have : ∀ i : fin (d + 1), i ∈ finset.univ.filter (λ x : fin (d + 1), ¬x ≤ j) → (0 : ℝ) = 0 :=
  begin
    intros i h,
    exact rfl,
  end,

  have hsum := finset.sum_eq_zero this,
  simp_rw function.comp_app at hsum,
  rw [hsum, add_zero],
  rw finset.sum_const,
  simp only [fin.val_eq_coe, nsmul_eq_mul, nat.cast_add, nat.cast_one, mul_eq_mul_right_iff],
  left,
  simp_rw [fin.le_def, ← fin.coe_eq_val],
  induction ↑j with j h,
  simp_rw nat.le_zero_iff,
  have : ∀ x : fin (d + 1), ↑x = 0 ↔ x = 0 :=
  begin
    intro x,
    have : (0 : fin (d + 1)).val = 0 :=
    begin
      simp?,
    end,
  end,
  rw ← fintype.card_subtype,

  -- have : {x : fin d // ↑x = 0} ≃ {x : fin d // x = 0} :=
  -- {
  --   to_fun :=
  --   begin
  --     intro x,
  --     have := subtype.prop x,
  --     have : x = 0 := sorry,
  --   end,
  --   inv_fun :=
  --   begin

  --   end,
  --   left_inv :=
  --   begin

  --   end,
  --   right_inv :=
  --   begin

  --   end,
  -- }

  -- change ↑0 + 1 = ↑((finset.univ.filter (eq 0)).card,
  -- rw finset.filter_eq,
  -- induction j with j hj h,

  -- rw finset.sum_comm,
end

lemma T_apply {x y : fin d → ℝ} :
  -- T x y = ∑ j : fin d, (∑ i : fin (j.val), (x (fin.cast_le j.is_lt i) - y (fin.cast_le j.is_lt i))) :=
  T x y = ∑ j : fin d, (∑ i : fin d in finset.univ.filter (λ i, i ≤ j), (x i - y i)) :=
begin
  rw T,
  induction d with d hd,
  simp only [finset.sum_sub_distrib,
 fin.val_eq_coe,
 finset.sum_empty,
 finset.filter_true_of_mem,
 nsmul_eq_mul,
 eq_self_iff_true,
 sub_zero,
 nat.cast_add,
 nat.cast_one,
 finset.sum_const_zero,
 finset.sum_congr,
 fintype.univ_of_is_empty],
  rw sum_split_last,
  rw sum_split_last,
  have : ∑ (j : fin d), (j.val + 1) • (y j - x j) = ∑ (i : fin d), ((i : fin d.succ).val + 1) • (y i - x i) :=
  begin
    sorry,
  end,
  rw ← this,
  rw hd,
  simp?,

  -- simp?,
  -- simp_rw hd,
  -- simp [hd],
  -- rw hd,
  sorry,
end

lemma eq₁ {d : ℕ} {x y : fin d → ℝ} (hmaj : majorizes x y) :
  T x y = ∑ j : fin (d - 1), (∑ i : fin j,
    (x (fin.cast_le (le_trans (le_of_lt j.is_lt) (nat.sub_le d 1)) i)
      - y (fin.cast_le (le_trans (le_of_lt j.is_lt) (nat.sub_le d 1)) i))) :=
begin
  rw T_apply hmaj,
  -- Maybe Hans knows how to manipulate these sorts of results
  -- rw finset.sum_eq_add_sum_diff_singleton (d - 1 ∈ (fin d).univ),
  sorry,
end

lemma eq₂ {d : ℕ} {x y : fin d → ℝ} (hmaj : majorizes x y) :
  ∑ i : fin d, | x i - y i | = ∑ i : fin (d - 1),
  (| x (fin.cast_le (nat.sub_le d 1) i) - y (fin.cast_le (nat.sub_le d 1) i) |
    + x (fin.cast_le (nat.sub_le d 1) i) - y (fin.cast_le (nat.sub_le d 1) i)) :=
begin
  sorry,
end

lemma compare_terms {d : ℕ} {j : fin d} {x y : fin d → ℝ} (hmaj : majorizes x y) (hj : ↑j < d) :
  | x j - y j | + x j - y j  ≤ 2 * ∑ i : fin j, (x (fin.cast_le hj i) - y (fin.cast_le hj i)) :=
begin
  sorry,
end

lemma sum_abs_le_T {d : ℕ} {x y : fin d → ℝ} (hmaj : majorizes x y) :
  ∑ i : fin d, | x i - y i | ≤ 2 * T x y :=
begin
  rw eq₁ hmaj,
  rw eq₂ hmaj,
  rw finset.mul_sum,
  apply finset.sum_le_sum,
  intro i,
  sorry
end