/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis, Yaël Dillies
-/
import algebra.module.pi
import algebra.module.prod
import algebra.order.pi
import algebra.order.smul
import data.set.pointwise

/-!
# Ordered module

In this file we provide lemmas about `ordered_smul` that hold once a module structure is present.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered scalar, ordered smul, ordered action, ordered vector space
-/

open_locale pointwise

variables {k M N : Type*}

namespace order_dual

instance [semiring k] [ordered_add_comm_monoid M] [module k M] : module k Mᵒᵈ :=
{ add_smul := λ r s x, order_dual.rec (add_smul _ _) x,
  zero_smul := λ m, order_dual.rec (zero_smul _) m }

end order_dual

section semiring
variables [ordered_semiring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

/- can be generalized from `module k M` to `distrib_mul_action_with_zero k M` once it exists.
where `distrib_mul_action_with_zero k M`is the conjunction of `distrib_mul_action k M` and
`smul_with_zero k M`.-/
lemma smul_neg_iff_of_pos (hc : 0 < c) :
  c • a < 0 ↔ a < 0 :=
begin
  rw [←neg_neg a, smul_neg, neg_neg_iff_pos, neg_neg_iff_pos],
  exact smul_pos_iff_of_pos hc,
end

end semiring

section ring
variables [ordered_ring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

lemma smul_lt_smul_of_neg (h : a < b) (hc : c < 0) :
  c • b < c • a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff],
  exact smul_lt_smul_of_pos h (neg_pos_of_neg hc),
end

lemma smul_le_smul_of_nonpos (h : a ≤ b) (hc : c ≤ 0) :
  c • b ≤ c • a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff],
  exact smul_le_smul_of_nonneg h (neg_nonneg_of_nonpos hc),
end

lemma eq_of_smul_eq_smul_of_neg_of_le (hab : c • a = c • b) (hc : c < 0) (h : a ≤ b) :
  a = b :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_inj] at hab,
  exact eq_of_smul_eq_smul_of_pos_of_le hab (neg_pos_of_neg hc) h,
end

lemma lt_of_smul_lt_smul_of_nonpos (h : c • a < c • b) (hc : c ≤ 0) :
  b < a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff] at h,
  exact lt_of_smul_lt_smul_of_nonneg h (neg_nonneg_of_nonpos hc),
end

lemma smul_lt_smul_iff_of_neg (hc : c < 0) :
  c • a < c • b ↔ b < a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_lt_neg_iff],
  exact smul_lt_smul_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_neg_iff_of_neg (hc : c < 0) :
  c • a < 0 ↔ 0 < a :=
begin
  rw [←neg_neg c, neg_smul, neg_neg_iff_pos],
  exact smul_pos_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_pos_iff_of_neg (hc : c < 0) :
  0 < c • a ↔ a < 0 :=
begin
  rw [←neg_neg c, neg_smul, neg_pos],
  exact smul_neg_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_nonpos_of_nonpos_of_nonneg (hc : c ≤ 0) (ha : 0 ≤ a) : c • a ≤ 0 :=
calc
  c • a ≤ c • 0 : smul_le_smul_of_nonpos ha hc
  ... = 0 : smul_zero' M c

lemma smul_nonneg_of_nonpos_of_nonpos (hc : c ≤ 0) (ha : a ≤ 0) : 0 ≤ c • a :=
@smul_nonpos_of_nonpos_of_nonneg k Mᵒᵈ _ _ _ _ _ _ hc ha

alias smul_pos_iff_of_neg ↔ _ smul_pos_of_neg_of_neg
alias smul_neg_iff_of_pos ↔ _ smul_neg_of_pos_of_neg
alias smul_neg_iff_of_neg ↔ _ smul_neg_of_neg_of_pos

lemma antitone_smul_left (hc : c ≤ 0) : antitone (has_scalar.smul c : M → M) :=
λ a b h, smul_le_smul_of_nonpos h hc

lemma strict_anti_smul_left (hc : c < 0) : strict_anti (has_scalar.smul c : M → M) :=
λ a b h, smul_lt_smul_of_neg h hc

/-- Binary **rearrangement inequality**. -/
lemma smul_add_smul_le_smul_add_smul [contravariant_class M M (+) (≤)] {a b : k} {c d : M}
  (hab : a ≤ b) (hcd : c ≤ d) :
  a • d + b • c ≤ a • c + b • d :=
begin
  obtain ⟨b, rfl⟩ := exists_add_of_le hab,
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd,
  rw [smul_add, add_right_comm, smul_add, ←add_assoc, add_smul _ _ d],
  rw le_add_iff_nonneg_right at hab hcd,
  exact add_le_add_left (le_add_of_nonneg_right $ smul_nonneg hab hcd) _,
end

/-- Binary **rearrangement inequality**. -/
lemma smul_add_smul_le_smul_add_smul' [contravariant_class M M (+) (≤)] {a b : k} {c d : M}
  (hba : b ≤ a) (hdc : d ≤ c) : a • d + b • c ≤ a • c + b • d :=
by { rw [add_comm (a • d), add_comm (a • c)], exact smul_add_smul_le_smul_add_smul hba hdc }

/-- Binary strict **rearrangement inequality**. -/
lemma smul_add_smul_lt_smul_add_smul [covariant_class M M (+) (<)] [contravariant_class M M (+) (<)]
  {a b : k} {c d : M} (hab : a < b) (hcd : c < d) : a • d + b • c < a • c + b • d :=
begin
  obtain ⟨b, rfl⟩ := exists_add_of_le hab.le,
  obtain ⟨d, rfl⟩ := exists_add_of_le hcd.le,
  rw [smul_add, add_right_comm, smul_add, ←add_assoc, add_smul _ _ d],
  rw lt_add_iff_pos_right at hab hcd,
  exact add_lt_add_left (lt_add_of_pos_right _ $ smul_pos hab hcd) _,
end

/-- Binary strict **rearrangement inequality**. -/
lemma smul_add_smul_lt_smul_add_smul' [covariant_class M M (+) (<)]
  [contravariant_class M M (+) (<)] {a b : k} {c d : M} (hba : b < a) (hdc : d < c) :
  a • d + b • c < a • c + b • d :=
by { rw [add_comm (a • d), add_comm (a • c)], exact smul_add_smul_lt_smul_add_smul hba hdc }

end ring

section field
variables [linear_ordered_field k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {a b : M} {c : k}

lemma smul_le_smul_iff_of_neg (hc : c < 0) : c • a ≤ c • b ↔ b ≤ a :=
begin
  rw [←neg_neg c, neg_smul, neg_smul (-c), neg_le_neg_iff],
  exact smul_le_smul_iff_of_pos (neg_pos_of_neg hc),
end

lemma smul_lt_iff_of_neg (hc : c < 0) : c • a < b ↔ c⁻¹ • b < a :=
begin
  rw [←neg_neg c, ←neg_neg a, neg_smul_neg, inv_neg, neg_smul _ b, neg_lt_neg_iff],
  exact smul_lt_iff_of_pos (neg_pos_of_neg hc),
end

lemma lt_smul_iff_of_neg (hc : c < 0) : a < c • b ↔ b < c⁻¹ • a :=
begin
  rw [←neg_neg c, ←neg_neg b, neg_smul_neg, inv_neg, neg_smul _ a, neg_lt_neg_iff],
  exact lt_smul_iff_of_pos (neg_pos_of_neg hc),
end

variables (M)

/-- Left scalar multiplication as an order isomorphism. -/
@[simps] def order_iso.smul_left_dual {c : k} (hc : c < 0) : M ≃o Mᵒᵈ :=
{ to_fun := λ b, order_dual.to_dual (c • b),
  inv_fun := λ b, c⁻¹ • (order_dual.of_dual b),
  left_inv := inv_smul_smul₀ hc.ne,
  right_inv := smul_inv_smul₀ hc.ne,
  map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_neg hc }

variables {M} [ordered_add_comm_group N] [module k N] [ordered_smul k N]

-- TODO: solve `prod.has_lt` and `prod.has_le` misalignment issue
instance prod.ordered_smul : ordered_smul k (M × N) :=
ordered_smul.mk' $ λ (v u : M × N) (c : k) h hc,
  ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩

instance pi.smul_with_zero'' {ι : Type*} {M : ι → Type*} [Π i, ordered_add_comm_group (M i)]
  [Π i, mul_action_with_zero k (M i)] :
  smul_with_zero k (Π i : ι, M i) := by apply_instance

instance pi.ordered_smul {ι : Type*} {M : ι → Type*} [Π i, ordered_add_comm_group (M i)]
  [Π i, mul_action_with_zero k (M i)] [∀ i, ordered_smul k (M i)] :
  ordered_smul k (Π i : ι, M i) :=
begin
  refine (ordered_smul.mk' $ λ v u c h hc i, _),
  change c • v i ≤ c • u i,
  exact smul_le_smul_of_nonneg (h.le i) hc.le,
end

-- Sometimes Lean fails to apply the dependent version to non-dependent functions,
-- so we define another instance
instance pi.ordered_smul' {ι : Type*} {M : Type*} [ordered_add_comm_group M]
  [mul_action_with_zero k M] [ordered_smul k M] :
  ordered_smul k (ι → M) :=
pi.ordered_smul

end field

/-! ### Upper/lower bounds -/

section ordered_semiring
variables [ordered_semiring k] [ordered_add_comm_monoid M] [smul_with_zero k M] [ordered_smul k M]
  {s : set M} {c : k}

lemma smul_lower_bounds_subset_lower_bounds_smul (hc : 0 ≤ c) :
  c • lower_bounds s ⊆ lower_bounds (c • s) :=
(monotone_smul_left hc).image_lower_bounds_subset_lower_bounds_image

lemma smul_upper_bounds_subset_upper_bounds_smul (hc : 0 ≤ c) :
  c • upper_bounds s ⊆ upper_bounds (c • s) :=
(monotone_smul_left hc).image_upper_bounds_subset_upper_bounds_image

lemma bdd_below.smul_of_nonneg (hs : bdd_below s) (hc : 0 ≤ c) : bdd_below (c • s) :=
(monotone_smul_left hc).map_bdd_below hs

lemma bdd_above.smul_of_nonneg (hs : bdd_above s) (hc : 0 ≤ c) : bdd_above (c • s) :=
(monotone_smul_left hc).map_bdd_above hs

end ordered_semiring

section ordered_ring
variables [ordered_ring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M]
  {s : set M} {c : k}

lemma smul_lower_bounds_subset_upper_bounds_smul (hc : c ≤ 0) :
  c • lower_bounds s ⊆ upper_bounds (c • s) :=
(antitone_smul_left hc).image_lower_bounds_subset_upper_bounds_image

lemma smul_upper_bounds_subset_lower_bounds_smul (hc : c ≤ 0) :
  c • upper_bounds s ⊆ lower_bounds (c • s) :=
(antitone_smul_left hc).image_upper_bounds_subset_lower_bounds_image

lemma bdd_below.smul_of_nonpos (hc : c ≤ 0) (hs : bdd_below s) : bdd_above (c • s) :=
(antitone_smul_left hc).map_bdd_below hs

lemma bdd_above.smul_of_nonpos (hc : c ≤ 0) (hs : bdd_above s) : bdd_below (c • s) :=
(antitone_smul_left hc).map_bdd_above hs

end ordered_ring

section linear_ordered_field
variables [linear_ordered_field k] [ordered_add_comm_group M]

section mul_action_with_zero
variables [mul_action_with_zero k M] [ordered_smul k M] {s t : set M} {c : k}

@[simp] lemma lower_bounds_smul_of_pos (hc : 0 < c) : lower_bounds (c • s) = c • lower_bounds s :=
(order_iso.smul_left _ hc).lower_bounds_image

@[simp] lemma upper_bounds_smul_of_pos (hc : 0 < c) : upper_bounds (c • s) = c • upper_bounds s :=
(order_iso.smul_left _ hc).upper_bounds_image

@[simp] lemma bdd_below_smul_iff_of_pos (hc : 0 < c) : bdd_below (c • s) ↔ bdd_below s :=
(order_iso.smul_left _ hc).bdd_below_image

@[simp] lemma bdd_above_smul_iff_of_pos (hc : 0 < c) : bdd_above (c • s) ↔ bdd_above s :=
(order_iso.smul_left _ hc).bdd_above_image

end mul_action_with_zero

section module
variables [module k M] [ordered_smul k M] {s t : set M} {c : k}

@[simp] lemma lower_bounds_smul_of_neg (hc : c < 0) : lower_bounds (c • s) = c • upper_bounds s :=
(order_iso.smul_left_dual M hc).upper_bounds_image

@[simp] lemma upper_bounds_smul_of_neg (hc : c < 0) : upper_bounds (c • s) = c • lower_bounds s :=
(order_iso.smul_left_dual M hc).lower_bounds_image

@[simp] lemma bdd_below_smul_iff_of_neg (hc : c < 0) : bdd_below (c • s) ↔ bdd_above s :=
(order_iso.smul_left_dual M hc).bdd_above_image

@[simp] lemma bdd_above_smul_iff_of_neg (hc : c < 0) : bdd_above (c • s) ↔ bdd_below s :=
(order_iso.smul_left_dual M hc).bdd_below_image

end module
end linear_ordered_field


import tactic
import data.real.sqrt
import analysis.specific_limits.basic
import analysis.specific_limits.normed

open filter real

open_locale topological_space

theorem rudin_4_1 :
  ∃ (f : ℝ → ℝ), (∀ (x : ℝ), tendsto (λ y, f(x + y) - f(x - y))
  (𝓝 0) (𝓝 0)) ∧ ¬ continuous f :=
begin
  sorry,
end

theorem rudin_4_2 {α β: Type*} [metric_space α] [metric_space β] (f : α → β)
  (h₁ : continuous f) :
  ∀ (x : set α), f '' (closure x) ⊆ closure (f '' x) :=
begin
  sorry,
end

theorem rudin_4_3 {α : Type*} [metric_space α] (f : α → ℝ) (h : continuous f)
 (z : set α) (g : z = f⁻¹' {0}) :
 is_closed z :=
begin
  rw g,
  apply is_closed.preimage h,
  exact is_closed_singleton,
end

theorem rudin_4_4a
  {α β: Type*} [metric_space α] [metric_space β] (f : α → β)
  (h₁ : continuous f) (s : set α) (h₂ : dense s) :
  closure (f '' s) = set.range f :=
begin
  sorry,
end

theorem rudin_4_4b {α β: Type*} [metric_space α] [metric_space β] (f g: α → β)
  (h₁ : continuous f) (h₂ : continuous g) (s : set α) (h₃ : dense s)
  (h₄ : ∀ x ∈ s, f x = g x) :
  f = g :=
begin
  sorry,
end


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

import topology.algebra.uniform_field
import analysis.complex.basic
import field_theory.adjoin

/-!
# Some results about the topology of ℂ
-/

section complex_subfield

open complex set

open_locale complex_conjugate

/-- The only closed subfields of `ℂ` are `ℝ` and `ℂ`. -/
lemma complex.subfield_eq_of_closed {K : subfield ℂ} (hc : is_closed (K : set ℂ)) :
  K = of_real.field_range ∨ K = ⊤ :=
begin
  suffices : range (coe : ℝ → ℂ) ⊆ K,
  { rw [range_subset_iff, ← coe_algebra_map] at this,
    have := (subalgebra.is_simple_order_of_finrank finrank_real_complex).eq_bot_or_eq_top
      (subfield.to_intermediate_field K this).to_subalgebra,
    simp_rw ← set_like.coe_set_eq at this ⊢,
    convert this using 2,
    simpa only [ring_hom.coe_field_range, algebra.coe_bot, coe_algebra_map], },
  suffices : range (coe : ℝ → ℂ) ⊆ closure (set.range ((coe : ℝ → ℂ) ∘ (coe : ℚ → ℝ))),
  { refine subset_trans this _,
    rw ← is_closed.closure_eq hc,
    apply closure_mono,
    rintros _ ⟨_, rfl⟩,
    simp only [function.comp_app, of_real_rat_cast, set_like.mem_coe, subfield_class.coe_rat_mem] },
  nth_rewrite 1 range_comp,
  refine subset_trans _ (image_closure_subset_closure_image continuous_of_real),
  rw dense_range.closure_range rat.dense_embedding_coe_real.dense,
  simp only [image_univ],
end

/-- Let `K` a subfield of `ℂ` and let `ψ : K →+* ℂ` a ring homomorphism. Assume that `ψ` is uniform
continuous, then `ψ` is either the inclusion map or the composition of the inclusion map with the
complex conjugation. -/
lemma complex.uniform_continuous_ring_hom_eq_id_or_conj (K : subfield ℂ) {ψ : K →+* ℂ}
  (hc : uniform_continuous ψ) : ψ.to_fun = K.subtype ∨ ψ.to_fun = conj ∘ K.subtype :=
begin
  letI : topological_division_ring ℂ := topological_division_ring.mk,
  letI : topological_ring K.topological_closure :=
      subring.topological_ring K.topological_closure.to_subring,
  set ι : K → K.topological_closure := subfield.inclusion K.le_topological_closure,
  have ui : uniform_inducing ι :=
    ⟨ by { erw [uniformity_subtype, uniformity_subtype, filter.comap_comap], congr, } ⟩,
  let di := ui.dense_inducing _,
  { -- extψ : closure(K) →+* ℂ is the extension of ψ : K →+* ℂ
    let extψ := dense_inducing.extend_ring_hom ui di.dense hc,
    haveI := (uniform_continuous_uniformly_extend ui di.dense hc).continuous,
    cases complex.subfield_eq_of_closed (subfield.is_closed_topological_closure K),
    { left,
      let j := ring_equiv.subfield_congr h,
      -- ψ₁ is the continuous ring hom `ℝ →+* ℂ` constructed from `j : closure (K) ≃+* ℝ`
      -- and `extψ : closure (K) →+* ℂ`
      let ψ₁ := ring_hom.comp extψ (ring_hom.comp j.symm.to_ring_hom of_real.range_restrict),
      ext1 x,
      rsuffices ⟨r, hr⟩ : ∃ r : ℝ, of_real.range_restrict r = j (ι x),
      { have := ring_hom.congr_fun
          (ring_hom_eq_of_real_of_continuous (by continuity! : continuous ψ₁)) r,
        rw [ring_hom.comp_apply, ring_hom.comp_apply, hr, ring_equiv.to_ring_hom_eq_coe] at this,
        convert this using 1,
        { exact (dense_inducing.extend_eq di hc.continuous _).symm, },
        { rw [← of_real.coe_range_restrict, hr], refl, }},
      obtain ⟨r, hr⟩ := set_like.coe_mem (j (ι x)),
      exact ⟨r, subtype.ext hr⟩, },
    { -- ψ₁ is the continuous ring hom `ℂ →+* ℂ` constructed from `closure (K) ≃+* ℂ`
      -- and `extψ : closure (K) →+* ℂ`
      let ψ₁ := ring_hom.comp extψ (ring_hom.comp (ring_equiv.subfield_congr h).symm.to_ring_hom
        (@subfield.top_equiv ℂ _).symm.to_ring_hom),
      cases ring_hom_eq_id_or_conj_of_continuous (by continuity! : continuous ψ₁) with h h,
      { left, ext1 z,
        convert (ring_hom.congr_fun h z) using 1,
        exact (dense_inducing.extend_eq di hc.continuous z).symm, },
      { right, ext1 z,
        convert (ring_hom.congr_fun h z) using 1,
        exact (dense_inducing.extend_eq di hc.continuous z).symm, }}},
  { let j : { x // x ∈ closure (id '' {x | (K : set ℂ) x })} → (K.topological_closure : set ℂ) :=
      λ x, ⟨x, by { convert x.prop, simpa only [id.def, set.image_id'], }⟩,
    convert dense_range.comp (function.surjective.dense_range _)
      (dense_embedding.subtype (dense_embedding_id) (K : set ℂ)).dense
      (by continuity : continuous j),
    rintros ⟨y, hy⟩,
    use ⟨y, by { convert hy, simpa only [id.def, set.image_id'], }⟩,
    simp only [subtype.mk_eq_mk, subtype.coe_mk], }
end

end complex_subfield


import combinatorics.simple_graph.clique
import combinatorics.simple_graph.degree_sum
import data.finset.basic
import data.list.basic
import data.nat.basic
import tactic.core

import algebra.big_operators

-- local
import nbhd_res
import turanpartition

open finset nat turanpartition

open_locale big_operators

namespace simple_graph

section multipartite

variable {t : ℕ}
variables {α : Type*}[fintype α][nonempty α][decidable_eq α]
variables{M : multi_part α}

include M
-- given a t+1 partition on A form the complete multi-partite graph on A
-- with all edges present between different parts in M.A and no edges involving vertices outside A or inside any part of A
@[ext,reducible]
def mp (M: multi_part α) : simple_graph α:={
  adj:= λ x y, (∃ i ∈ range(M.t+1), ∃ j ∈ range(M.t+1), i≠j ∧ ((x ∈ M.P i ∧ y ∈ M.P j) ∨ (x ∈ M.P j ∧ y ∈ M.P i))),
  symm:=
  begin
    intros x y hxy,
    obtain ⟨i,hi,j,hj,ne,⟨hx,hy⟩⟩:=hxy,
    {refine ⟨j ,hj, i, hi, ne.symm,_ ⟩, left ,exact ⟨hy,hx⟩},
    {refine ⟨i ,hi, j, hj, ne,_ ⟩, left, rwa and_comm},
  end,
  loopless:=begin
    intro x, push_neg, intros i hi j hj ne,
    split; intros hxi hxj, exact M.disj i hi j hj ne (mem_inter.mpr ⟨hxi,hxj⟩),
    exact M.disj i hi j hj ne (mem_inter.mpr ⟨hxj,hxi⟩),
end,}

instance mp_decidable_rel : decidable_rel (mp M).adj :=
λ x y, finset.decidable_dexists_finset

instance neighbor_mp_set.mem_decidable (v : α): decidable_pred (∈ (mp M).neighbor_set v) :=by apply_instance

instance multi_partite_fintype  : fintype (mp M).edge_set :=by apply_instance

--any vertex in α but not in A is isolated
lemma no_nbhrs {M: multi_part α} {v w: α} (hA: v∉M.A) : ¬(mp M).adj v w:=
begin
  contrapose! hA,
  obtain ⟨i,hi,j,hj,ne,hv⟩:=hA, cases hv, {exact (sub_part hi) hv.1},
  {exact (sub_part hj) hv.1},
end

-- having any neighbour implies the vertex is in A
lemma nbhrs_imp {M: multi_part α} {v w: α} : (mp M).adj v w → v ∈ M.A:=
begin
  intros h1, by_contra, exact no_nbhrs h h1,
end

-- if v and w belong to parts P i and P j and vw is an edge then i≠j
lemma mp_adj_imp {M : multi_part α} {v w: α} {i j : ℕ} (hi: i∈ range(M.t+1))(hj: j∈ range(M.t+1))(hvi: v∈M.P i) (hwj: w∈M.P j): (mp M).adj v w → i≠j:=
begin
  intros h,cases h with a ha,
  obtain ⟨har,b,hbr,abne, ab⟩:=ha, cases ab,
  have ai:=uniq_part hi har hvi ab.1,have bj:=uniq_part hj hbr hwj ab.2,
  rwa [← ai,← bj] at abne,
  have aj:=uniq_part hj har hwj ab.2, have bi:=uniq_part hi hbr hvi ab.1,
  rw [← aj,← bi] at abne,
  exact abne.symm,
end

--if v and w are in distinct parts then they are adjacent
lemma mp_imp_adj {M : multi_part α} {v w: α} {i j : ℕ}(hi: i∈ range(M.t+1))(hj: j∈ range(M.t+1))(hvi: v∈M.P i) (hwj: w∈M.P j): i≠ j → (mp M).adj v w :=
begin
  intros h, refine ⟨i,hi,j,hj,h,_⟩,left ,exact ⟨hvi,hwj⟩,
end

--if v in P i and vw is an edge then w ∉ P i
lemma not_nbhr_same_part {M : multi_part α} {v w: α} {i : ℕ} (hi : i∈ range(M.t+1)) (hv: v∈ M.P i) : (mp M).adj v w → w ∉ M.P i:=
begin
  intros h1, by_contra, apply mp_adj_imp hi hi hv h h1,refl,
end

-- given two vertices in the same part they are not adjacent
lemma not_nbhr_same_part' {M : multi_part α} {v w: α} {i : ℕ} (hi : i∈ range(M.t+1)) (hv: v∈ M.P i) (hw: w∈ M.P i): ¬(mp M).adj v w :=
begin
  intros h1, contrapose hw, exact not_nbhr_same_part hi hv h1,
end

-- if v in P i  and w in A\(P i) then vw is an edge
lemma nbhr_diff_parts {M : multi_part α} {v w: α} {i : ℕ} (hi : i∈ range(M.t+1)) (hv: v∈ M.P i) (hw : w∈ M.A\M.P i)
 : (mp M).adj v w:=
begin
  rw mem_sdiff at hw,
  cases hw with hA hni,
  rw M.uni at hA, rw mem_bUnion at hA,
  obtain ⟨j,hj1,hj2⟩:=hA,
  refine mp_imp_adj hi hj1 hv hj2 _, intro h, rw h at hni, exact hni hj2
end

--if v is in P i then its nbhd is A\(P i)
lemma mp_nbhd {M : multi_part α} {v:α} {i: ℕ} (hv: i∈ range(M.t+1) ∧ v ∈ M.P i) : (mp M).neighbor_finset v = (M.A)\(M.P i) :=
begin
  ext,split,{rw mem_neighbor_finset,intro h, rw adj_comm at h,
  rw mem_sdiff, refine  ⟨nbhrs_imp h,_⟩, exact not_nbhr_same_part hv.1 hv.2 h.symm},
  {rw mem_neighbor_finset, exact nbhr_diff_parts hv.1 hv.2},
end

-- degree sum over all vertices i.e. 2*e(mp M)
def mp_dsum (M : multi_part α) : ℕ:= ∑ v in M.A, (mp M).degree v

-- degree of vertex in P i is card(A\P i)
lemma mp_deg {M : multi_part α} {v : α} {i: ℕ} (hv: i∈ range(M.t+1) ∧ v∈ M.P i) : (mp M).degree v = ((M.A)\(M.P i)).card:=
begin
  rw degree,rwa mp_nbhd hv,
end

-- degree of v in P i as |A|- |P i|
lemma mp_deg_diff {M : multi_part α} {v : α} {i: ℕ} (hv: i∈ range(M.t+1) ∧ v∈ M.P i) : (mp M).degree v = M.A.card -  (M.P i).card:=
begin
  rw mp_deg hv, exact card_sdiff (sub_part hv.1),
end

-- sum of degrees as sum over parts
lemma mp_deg_sum (M : multi_part α) : ∑ v in M.A, (mp M).degree v = ∑i in range(M.t+1),(M.P i).card * ((M.A)\(M.P i)).card :=
begin
  nth_rewrite 0 M.uni,
  rw sum_bUnion (pair_disjoint M), apply finset.sum_congr rfl _,
  intros x hx, rw [finset.card_eq_sum_ones, sum_mul, one_mul], apply finset.sum_congr rfl _,
  intros v hv, exact mp_deg ⟨hx,hv⟩,
end

--- same using squares of part sizes and avoiding the cursed tsubtraction
lemma mp_deg_sum_sq' (M : multi_part α) : ∑ v in M.A, (mp M).degree v + ∑i in range(M.t+1), (M.P i).card^2 = M.A.card^2:=
begin
  rw mp_deg_sum M, rw pow_two, nth_rewrite 0 card_uni, rw ← sum_add_distrib, rw sum_mul,
  refine finset.sum_congr rfl _,
  intros x hx,rw pow_two,rw ← mul_add, rw card_part_uni hx,
end

-- expressed  as |A|^2- ∑ degrees squared
lemma mp_deg_sum_sq (M : multi_part α) : ∑ v in M.A, (mp M).degree v = M.A.card^2 - ∑i in range(M.t+1), (M.P i).card^2
:=eq_tsub_of_add_eq (mp_deg_sum_sq' M)

-- turan_partition partition corresponds to balanced partition sizes so if we have two turan_partition partitions
-- of same set A into the same number of parts then their degree sums are the the same
lemma turan_partition_deg_sum_eq (M N : multi_part α): M.A= N.A → M.t=N.t → turan_partition M → turan_partition N → mp_dsum M = mp_dsum N:=
begin
   intros hA ht iM iN, unfold mp_dsum,  rw [mp_deg_sum_sq,mp_deg_sum_sq,hA], rw [turan_partition_iff_not_moveable, moveable,not_not] at *,
   apply congr_arg _,
   have hN:= turan_bal iN, rw [← ht , ← hA] at hN,
   have:= bal_turan_help' (turan_bal iM) hN, rwa ← ht,
end

-- this is the part of the degree sum that has changed by moving a vertex
lemma mp_deg_sum_move_help{M : multi_part α} {v : α} {i j: ℕ}  (hvi: i∈ range(M.t+1) ∧ v ∈ M.P i) (hj : j∈range(M.t+1) ∧ j≠i) (hc: (M.P j).card+1<(M.P i).card ) :
(M.P i).card * ((M.A)\(M.P i)).card + (M.P j).card * ((M.A)\(M.P j)).card <((move M hvi hj).P i).card * (((move M hvi hj).A)\((move M hvi hj).P i)).card + ((move M hvi hj).P j).card * (((move M hvi hj).A)\((move M hvi hj).P j)).card:=
begin
  rw [move_Pcard hvi hj hvi.1,  move_Pcard hvi hj hj.1, move_Pcard_sdiff hvi hj hvi.1,  move_Pcard_sdiff hvi hj hj.1],
  split_ifs,{exfalso, exact h.1 rfl},{exfalso, exact h.1 rfl},{exfalso, exact h.1 rfl},{exfalso, exact h_1.2 rfl},{exfalso, exact hj.2 h_2},
  {rw card_sdiff (sub_part hvi.1), rw card_sdiff (sub_part hj.1),
  exact move_change hc (two_parts hvi.1  hj.1 hj.2.symm)},
end

-- this is the part of the degree sum that hasn't changed by moving a vertex
lemma mp_deg_sum_move_help2{M : multi_part α} {v : α} {i j: ℕ}  (hvi: i∈ range(M.t+1) ∧ v ∈ M.P i) (hj : j∈range(M.t+1) ∧ j≠i)  :
∑ (x : ℕ) in ((range (M.t + 1)).erase j).erase i, ((move M hvi hj).P x).card * ((move M hvi hj).A \ (move M hvi hj).P x).card =
∑ (y : ℕ) in ((range (M.t + 1)).erase j).erase i, (M.P y).card*((M.A\(M.P y)).card):=
begin
  apply sum_congr rfl _, intros k hk, rw move_Pcard hvi hj, rw move_Pcard_sdiff hvi hj,split_ifs,{refl},
  {exfalso, rw h_1 at hk,exact not_mem_erase i _ hk}, {exfalso,push_neg at h, simp only [*, ne.def, not_false_iff, mem_erase, eq_self_iff_true] at *},
  {exact mem_of_mem_erase (mem_of_mem_erase hk)},   {exact mem_of_mem_erase (mem_of_mem_erase hk)},
end

-- given a vertex v ∈ P i and a part P j such that card(P j)+1 < card(P i) then moving v from Pi to Pj will increase the sum of degrees
-- putting the two previous lemmas together tells us that the move has increased the degree sum
lemma mp_deg_sum_move {M : multi_part α} {v : α} {i j: ℕ}  (hvi: i∈ range(M.t+1) ∧ v ∈ M.P i) (hj : j∈range(M.t+1) ∧ j≠i) (hc: (M.P j).card+1<(M.P i).card ) :
∑ w in M.A,  (mp M).degree w < ∑ w in (move M hvi hj).A,  (mp (move M hvi hj)).degree w :=
begin
  rw [mp_deg_sum M,mp_deg_sum (move M hvi hj), (move_t hvi hj)],
  rw [← sum_erase_add (range(M.t+1)) _ hj.1,← sum_erase_add (range(M.t+1)) _ hj.1],
  rw ← sum_erase_add ((range(M.t+1)).erase j) _ (mem_erase_of_ne_of_mem hj.2.symm hvi.1),
  rw ← sum_erase_add ((range(M.t+1)).erase j) _ (mem_erase_of_ne_of_mem hj.2.symm hvi.1),
  rw mp_deg_sum_move_help2,
  rw [add_assoc,add_assoc], refine (add_lt_add_iff_left _).mpr _ , exact mp_deg_sum_move_help hvi hj hc,
end

-- equivalently moving v from P i to P j reduces sum of sum_sq_c of part sizes (basically edges in the complement of mp)
lemma sum_sq_c_dec (M : multi_part α) {v : α} {i j: ℕ}  (hvi: i∈ range(M.t+1) ∧ v ∈ M.P i) (hj : j∈range(M.t+1) ∧ j≠i) (hc: (M.P j).card+1<(M.P i).card ) :
sum_sq_c (move M hvi hj) < sum_sq_c M:=
begin
  unfold sum_sq_c,
  have h3:=mp_deg_sum_move hvi hj hc,
  have h1:=mp_deg_sum_sq' M,   have h2:=mp_deg_sum_sq' (move M hvi hj), rw [move_A, move_t] at *,
  rw ← h2 at h1, rw move_t, linarith,
end

-- Given any partition M we can find a turan_partition on the same set with the same number of parts.
lemma moved (M : multi_part α) : ∃ N:multi_part  α, N.A = M.A ∧ N.t = M.t ∧ turan_partition N ∧ mp_dsum M ≤ mp_dsum N:=
begin
  apply well_founded.recursion (measure_wf sum_sq_c) M,
  intros X h,
  by_cases h': turan_partition X,{exact ⟨X,rfl,rfl,h', le_rfl⟩,},{
    obtain ⟨i,hi,j,hj,v,hv,ne,hc⟩:=not_turan_partition_imp h',
    set Y:=(move X ⟨hi,hv⟩ ⟨hj,ne⟩) with hY,
    specialize h Y (sum_sq_c_dec X ⟨hi,hv⟩ ⟨hj,ne⟩ hc),
    rw [move_t,move_A] at h, have :=mp_deg_sum_move  ⟨hi,hv⟩ ⟨hj,ne⟩ hc, rw [←mp_dsum,←mp_dsum,← hY] at this,
    obtain ⟨N,h1,h2,h3,h4⟩:=h, refine ⟨N,h1,h2,h3,_⟩, exact le_trans (le_of_lt this) h4,},
end

-- Only Turan graphs maximize number of edges:
-- given a turan_partition and any other partition on the same set and into same number of parts
-- that is not-turan, the degree sum of the former is strictly larger
lemma moved_max (M N:multi_part α): M.A =N.A → M.t =N.t → turan_partition M →  ¬turan_partition N → mp_dsum N < mp_dsum M:=
begin
  intros hA ht him h1,
  obtain ⟨i,hi,j,hj,v,hv,ne,hc⟩:= not_turan_partition_imp h1,
  set O:=(move N ⟨hi,hv⟩ ⟨hj,ne⟩) with hO, have Ns:mp_dsum N < mp_dsum O:=mp_deg_sum_move ⟨hi,hv⟩ ⟨hj,ne⟩ hc,
  obtain ⟨Q,QA,Qt,Qim,Qs⟩:=moved O, have :=turan_partition_deg_sum_eq M Q _ _ him Qim,rw this,
  {exact lt_of_lt_of_le Ns Qs}, {rw [hA,QA], have NOA:N.A=O.A:=move_A ⟨hi,hv⟩ ⟨hj,ne⟩,exact NOA},
  {rw[ht,Qt],  have NOt:N.t=O.t:=move_t ⟨hi,hv⟩ ⟨hj,ne⟩,exact NOt},
end

-- the degree sum of any complete (t+1)-partite graph is at most twice the turan numb of parts and set size
lemma turan_bound_M (M: multi_part α): mp_dsum M ≤ 2*turan_numb M.t M.A.card:=
begin
  obtain ⟨N,hA,ht,iN,sN⟩:=moved M,
  apply le_trans sN _, apply le_of_eq,
  rw turan_partition_iff_not_moveable at iN,rw moveable at iN, rw not_not at iN,rw P' at iN, rw ← hA,rw ←ht,
  have:= bal_turan_bd (turan_bal iN),
  rw sum_sq at this, rw  mp_dsum,rw mp_deg_sum_sq, unfold P' at this,
  rw [← this,  add_comm], simp only [add_tsub_cancel_right],
end

-- so if we have a partition of α then the number of edges is at most the turan number
lemma turan_max_edges (M: multi_part α): M.A=univ → (mp M).edge_finset.card ≤ turan_numb M.t (fintype.card α):=
begin
  intro hA, apply (mul_le_mul_left (by norm_num:0<2)).mp,
  rw ← sum_degrees_eq_twice_card_edges, have:=turan_bound_M M,  unfold mp_dsum at this,rw hA at this,
  rwa card_univ at this,
end

-- Now reformulate our bound to say that any complete multipartite graph on α that attains the turan bound is a turan_partition
lemma turan_eq_imp (M: multi_part α) (hu: M.A=univ):  (mp M).edge_finset.card = turan_numb M.t (fintype.card α) → turan_partition M:=
begin
  intros h, contrapose h, apply ne_of_lt, obtain ⟨N,NA,Nt,iN,le⟩:= moved M,
  apply (mul_lt_mul_left (by norm_num:0<2)).mp, rw ←sum_degrees_eq_twice_card_edges,
  have lt:=moved_max N M NA Nt iN h,
  have le2:=turan_bound_M N, unfold mp_dsum at *, rw hu at *,rw NA at *,rw Nt at *,rw card_univ at *,
  exact lt_of_lt_of_le lt le2,
end

-- finally need to verify that any turan partition does indeed attain the upper bound
lemma turan_imm_imp_eq (M: multi_part α) {t :ℕ} (hu: M.A=univ) (ht :M.t=t): turan_partition M → (mp M).edge_finset.card = turan_numb t (fintype.card α) :=
begin
  rw turan_partition_iff_not_moveable, unfold moveable, rw not_not,
  intros iM,  apply (nat.mul_right_inj (by norm_num:0<2)).mp, rw [←sum_degrees_eq_twice_card_edges, ←hu, ←ht],
  rw [mp_deg_sum_sq,  ← card_univ, ← hu],
  have cA:= card_uni M,
  rwa [← bal_turan_bd (turan_bal iM),  sum_sq, P', add_tsub_cancel_left],
end

--- next few results for counting degrees in mp once a new part has been inserted.

-- vertices in new part are adjacent to all old vertices
--- should have used lemmas from multipartite for this...
-- this says that the degree of any vertex in the new part equals the sum over the old parts

lemma mp_com (M : multi_part α) {C :finset α} (h: disjoint M.A C) :∀ v ∈ C, (mp (insert M h)).deg_res v M.A=(M.A.card):=
begin
 intros v hv, rw deg_res, congr, ext,
 rw mem_res_nbhd, simp only [mem_neighbor_finset, mem_range, ne.def, exists_prop, and_iff_left_iff_imp],
 intro ha, obtain⟨j,hjr,hjm⟩ :=inv_part ha,
 use j,rw insert_t,
 refine ⟨_,_,_,_,_⟩, {rw mem_range at *,linarith [hjr]}, {exact M.t+1},{linarith},
 {intro eq, rw eq at hjr, exact not_mem_range_self hjr},
 {right, rw insert_P, split_ifs,{exfalso, exact h_1 rfl},rw insert_P, refine ⟨hv,_⟩,split_ifs,{exact hjm},{
 push_neg at h_2,exfalso, rw h_2 at hjr,  exact not_mem_range_self hjr},},
end

-- given two vertices in the old partition they are adjacent in the partition with
-- C inserted iff they were already adjacent
lemma mp_old_adj (M :multi_part α) {C : finset α} {v w :α}(h: disjoint M.A C) : v∈ M.A → w ∈ M.A → ((mp M).adj v w ↔ (mp (insert M h)).adj v w):=
begin
  intros hv hw,
  split,{intro hins, obtain⟨k,hkr,l,hlr,lnek,lkc⟩:=hins,
  use k, rw insert_t,rw mem_range at *, refine ⟨(by linarith),l,_,lnek,_⟩,{
  rw mem_range,linarith [hlr]},{simp [insert_P],
  split_ifs,{exfalso,rw ← h_1 at hkr, exact lt_irrefl k hkr},
  {exfalso,rw ← h_1 at hkr, exact lt_irrefl k hkr},
  {exfalso,rw ← h_2 at hlr, exact lt_irrefl l hlr},
  {exact lkc},},},
  {intro hins, obtain⟨k,hkr,l,hlr,lnek,lkc⟩:=hins,rw insert_t at hkr,rw insert_t at hlr,
  refine ⟨k,_,l,_,lnek,_⟩,{
  rw mem_range at *,
  by_contra h', have :k=M.t+1:=by linarith [hkr,h],
  cases lkc,{ rw this at lkc, have vinb:=mem_inter.mpr ⟨hv,insert_C M h lkc.1⟩,
  exact h vinb}, {rw this at lkc, have vinb:=mem_inter.mpr ⟨hw,insert_C M h lkc.2⟩,
  exact h vinb},},{
  rw mem_range at *,
  by_contra h', have :l=M.t+1:=by linarith [hlr,h],
  cases lkc, {rw this at lkc, have vinb:=mem_inter.mpr ⟨hw,insert_C M h lkc.2⟩,
  exact h vinb},{ rw this at lkc, have vinb:=mem_inter.mpr ⟨hv,insert_C M h lkc.1⟩,
  exact h vinb},},{
  cases lkc, {rw [insert_P,insert_P] at lkc, split_ifs at lkc,{left, exact lkc},
  {exfalso, have winb:=mem_inter.mpr ⟨hw,lkc.2⟩,exact h winb},
  {exfalso, have vinb:=mem_inter.mpr ⟨hv,lkc.1⟩,exact h vinb},
  {exfalso, have winb:=mem_inter.mpr ⟨hw,lkc.2⟩,exact h winb},},{
  rw [insert_P,insert_P] at lkc, split_ifs at lkc,{right, exact lkc},
  {exfalso, have winb:=mem_inter.mpr ⟨hw,lkc.2⟩,exact h winb},
  {exfalso, have vinb:=mem_inter.mpr ⟨hv,lkc.1⟩,exact h vinb},
  {exfalso, have winb:=mem_inter.mpr ⟨hw,lkc.2⟩,exact h winb},},},},
end

-- previous lemma interpreted in terms of res nbhds
lemma mp_old_nbhd_res (M :multi_part α) {C : finset α} (h: disjoint M.A C) :∀v∈M.A, (mp (insert M h)).nbhd_res v M.A=(mp M).nbhd_res v M.A:=
begin
--  set H: simple_graph α:= (mp (insert M h)),
  intros v hv,ext,split,{intros ha, rw mem_res_nbhd at *,refine ⟨ha.1,_⟩,
  rw mem_neighbor_finset,rw mem_neighbor_finset at ha, exact (mp_old_adj M h hv ha.1).mpr ha.2},{
  intros ha, rw mem_res_nbhd at *,refine ⟨ha.1,_⟩,
  rw mem_neighbor_finset,rw mem_neighbor_finset at ha, exact (mp_old_adj M h hv ha.1).mp ha.2},
end

-- .. and in terms of deg res
lemma mp_old_deg_res (M :multi_part α) {C : finset α} (h: disjoint M.A C) :∀v∈M.A, (mp (insert M h)).deg_res v M.A=(mp M).deg_res v M.A:=
begin
  intros v hv, rw deg_res,rw deg_res,  rw mp_old_nbhd_res M h v hv,
end

-- so sum of deg res to old partition over old partition is unchanged
lemma mp_old_sum (M :multi_part α) {C : finset α} (h: disjoint M.A C) :∑ v in M.A, (mp (insert M h)).deg_res v M.A= ∑ v in M.A,(mp M).deg_res v M.A
:=sum_congr rfl (mp_old_deg_res M h)

-- vertices in the new part are not adjacent to each other
lemma mp_int_adj (M : multi_part α) {v w :α} {C :finset α} (h: disjoint M.A C) : v∈C → w∈C →  ¬(mp (insert M h)).adj v w:=
begin
  intros hv hw,   have vin:= insert_P' M h v hv,
  have win:= insert_P' M h w hw,
  have :=self_mem_range_succ (M.t+1), rw ← insert_t M h at this,
  contrapose win,push_neg at win, exact not_nbhr_same_part this vin win,
end

-- so their deg res to the new part is zero
lemma mp_int_deg_res (M : multi_part α) {C :finset α} (h: disjoint M.A C) : ∀v∈C,(mp (insert M h)).deg_res v C=0:=
begin
  intros v hv, rw deg_res, rw card_eq_zero, by_contra h',
  obtain ⟨w,hw,adw⟩ :=(mp (insert M h)).exists_mem_nempty h',
  exact (mp_int_adj M h hv hw) adw,
end

-- so the sum of their deg res to new part is also zero i.e. e(C)=0
lemma mp_int_sum (M : multi_part α) {C :finset α} (h: disjoint M.A C) :∑ v in C, (mp (insert M h)).deg_res v C=0:=
begin
  simp only [sum_eq_zero_iff], intros x hx, exact mp_int_deg_res M h x hx,
end

--- Counting edges in complete multipartite graphs:
--- if we add in a new part C then the sum of degrees over new vertex set
--  is sum over old + 2 edges in bipartite join
-- ie 2*e(M')=2*e(M)+2*e(M,C)
lemma mp_count (M : multi_part α) {C :finset α} (h: disjoint M.A C) :∑v in M.A, (mp M).deg_res v M.A +2*(M.A.card)*C.card =
∑ v in (insert M h).A, (mp (insert M h)).deg_res v (insert M h).A:=
begin
  set H: simple_graph α:= (mp (insert M h)),
  simp  [ insert_AB], rw sum_union h, rw [H.deg_res_add_sum' h,H.deg_res_add_sum' h],
  rw [add_assoc ,mp_int_sum M h,  add_zero,  H.bip_count' h.symm],
  rw [← sum_add_distrib, card_eq_sum_ones C, mul_sum,  mp_old_sum M h ,add_right_inj],
  apply sum_congr rfl, rw [(by norm_num: 2= 1+1),add_mul, one_mul, mul_one], intros x hx, rwa (mp_com M h x hx),
end

--- Any complete (t+1)-partite graph is (t+2)-clique free.
lemma mp_clique_free (M: multi_part α): M.t=t → M.A=univ →  (mp M).clique_free (t+2):=
begin
  intros ht hA, by_contra, unfold clique_free at h, push_neg at h,
  obtain ⟨S,hs1,hs2⟩:=h, rw is_clique_iff at hs1,
  -- would now like to invoke the pigeonhole principle
  -- have t+2 pigeons in t+1 classes so two in some class which are then non-adjacent...
  -- i did try to find this in mathlib but it was late so...
  suffices : ∃ i∈range(M.t +1),1 < (S∩(M.P i)).card,{
    obtain ⟨i,hi,hc⟩:=this,  rw [one_lt_card_iff] at hc,
    obtain ⟨a,b,ha,hb,ne⟩:=hc, rw mem_inter at *,
    have nadj:= not_nbhr_same_part' hi  ha.2 hb.2,
    exact nadj  (hs1 ha.1 hb.1 ne),},
  by_contra, push_neg at h,
  have ub:(range(M.t+1)).sum (λi, (S∩ (M.P i)).card)≤ M.t+1,{
    nth_rewrite_rhs 0 ← card_range (M.t+1), nth_rewrite_rhs 0 card_eq_sum_ones,
    apply sum_le_sum h,}, nth_rewrite_rhs 0 ht at ub,
    have uni:=bUnion_parts M, rw hA at uni,
    have sin:=inter_univ S, rw [uni ,inter_bUnion] at sin,
    rw [← sin, card_bUnion] at hs2, linarith,
    intros x hx y hy ne,
    apply disj_of_disj_inter S S (M.disj x hx y hy ne),
end

end multipartite

end simple_graph


import algebra.order.field.basic tactic.linarith

/-! # IMO 2011 A6 (P3) -/

namespace IMOSL
namespace IMO2011A6

/-- Final solution -/
theorem final_solution {R : Type*} [linear_ordered_comm_ring R]
  {f : R → R} (h : ∀ x y : R, f (x + y) ≤ y * f x + f (f x)) :
  ∀ x : R, x ≤ 0 → f x = 0 :=
begin
  ---- A sequence of results
  have h0 : ∀ t x : R, f (f t) ≤ (f t - x) * f x + f (f x) := λ t x,
    by replace h := h x (f t - x); rwa add_sub_cancel'_right at h,
  replace h0 : ∀ x : R, x * f x ≤ 0 := λ x,
    by linarith [h0 (2 * f x) x, h0 x (2 * f x)],
  have h1 : ∀ x : R, f x ≤ f (f x) := λ x,
    by replace h := h x 0; rwa [add_zero, zero_mul, zero_add] at h,
  have h2 : ∀ x : R, f x ≤ 0 := λ x,
    by contrapose! h1; exact ⟨x, lt_of_le_of_lt (nonpos_of_mul_nonpos_right (h0 (f x)) h1) h1⟩,
  replace h0 : ∀ x : R, x < 0 → f x = 0 := λ x hx,
    le_antisymm (h2 x) (nonneg_of_mul_nonpos_right (h0 x) hx),

  ---- Finishing
  intros x h,
  rw le_iff_lt_or_eq at h; rcases h with h | rfl,
  exact h0 x h,
  refine le_antisymm (h2 0) _,
  rw ← h0 (-1) neg_one_lt_zero; exact h1 (-1)
end

end IMO2011A6
end IMOSL


universes v u v₁ u₁ v₂ u₂ v₃ u₃

/-
  notation: C +→ D = functor from C to D
  notation: F₁ →ₙ F₂ = natural transformation from F₁ to F₂
-/

class category (obj : Type u ) : Type (max u (v+1)) :=
  (Mor : obj → obj → Type v)
  (comp : Π {A B C : obj}, Mor B C → Mor A B → Mor A C)
  (idₘ : Π A : obj, Mor A A)
  (comp_assoc : ∀ {A B C D: obj} (f₁ : Mor A B) (f₂ : Mor B C) (f₃ : Mor C D),
     (comp f₃ (comp f₂ f₁)) = comp (comp f₃ f₂) f₁)
  (id_comp_left : ∀ {A B : obj} (f : Mor A B), comp (idₘ B) f = f)
  (id_comp_right : ∀ {A B : obj} (f : Mor A B), comp f (idₘ A) = f)

namespace category

notation f ` ∘ₘ `:80 g:80 := category.comp f g

structure functor (C : Type u₁) (D : Type u₂) [category.{v₁} C] [category.{v₂} D] :=
  (map : C → D)
  (fmap : Π {A B : C}, Mor A B → Mor (map A) (map B))
  (fmap_prevs_comp : ∀ {A₁ A₂ A₃ : C} (f₁ : Mor A₂ A₃) (f₂ : Mor A₁ A₂) , fmap (f₁ ∘ₘ f₂) = (fmap f₁) ∘ₘ (fmap f₂))
  (fmap_prevs_id : ∀ A : C, fmap (idₘ A) = idₘ (map A))

notation C ` +→ `:80 D:80 := functor C D

def faithful_functor {C : Type u₁} {D: Type u₂} [category.{v₁} C] [category.{v₂} D] (F : C +→ D) : Prop
  := ∀ (A B : C) (f g : Mor A B) , F.fmap f = F.fmap g → f = g

def equal_to_morphism {C : Type u} [category.{v} C] {A B : C} : A = B → Mor A B :=
begin
  intro h,
  rw h,
  exact idₘ B,
end

theorem functor_equality {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] (F₁ F₂ : C +→ D)
  : F₁.map = F₂.map → F₁.fmap == F₂.fmap → F₁ = F₂ :=
begin
  cases F₁,
  cases F₂,
  intros h₁ h₂,
  simp,
  split,
  exact h₁,
  exact h₂,
end

def functor_comp {C₁ : Type u₁} {C₂ : Type u₂} {C₃ : Type u₃} [category.{v₁} C₁] [category.{v₂} C₂] [category.{v₃} C₃]
  (F₁ : C₂ +→ C₃) (F₂ : C₁ +→ C₂) : C₁ +→ C₃ :=
{
  map := (λ o, F₁.map (F₂.map o)),
  fmap := (λ A B f , F₁.fmap  (F₂.fmap f)),
  fmap_prevs_comp :=
    begin
      intros A₁ A₂ A₃ f₁ f₂,
      rw F₂.fmap_prevs_comp,
      rw F₁.fmap_prevs_comp,
    end,
  fmap_prevs_id :=
    begin
      intro A,
      rw F₂.fmap_prevs_id,
      rw F₁.fmap_prevs_id,
    end,
}

notation C ` ⊚ `:80 D:80 := functor_comp C D

def id_func (C : Type u) [category.{v} C] : C +→ C :=
{
  map := id,
  fmap := λ _ _, id,
  fmap_prevs_comp :=
    begin
      intros A₁ A₂ A₃ f₁ f₂,
      refl,
    end,
  fmap_prevs_id :=
    begin
      intro,
      refl,
    end,
}

structure natural_transformation {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] (F₁ F₂ : C +→ D) :=
  (map : Π c : C, Mor (F₁.map c) (F₂.map c))
  (natural : ∀ (c : C) {c' : C} (f : Mor c c'), (F₂.fmap f) ∘ₘ (map c)  = (map c') ∘ₘ (F₁.fmap f))

notation F₁ ` →ₙ `:80 F₂:80 := natural_transformation F₁ F₂

theorem natural_trans_equality {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] {F₁ F₂ : C +→ D} {φ₁ φ₂: F₁ →ₙ F₂}
  : φ₁.map = φ₂.map → φ₁ = φ₂ :=
begin
  intro h,
  cases φ₁,
  cases φ₂,
  rw natural_transformation.mk.inj_eq,
  exact h,
end

def natural_trans_comp {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] {F₁ F₂ F₃: C +→ D}
  : F₂ →ₙ F₃ → F₁ →ₙ F₂ → F₁ →ₙ F₃ := λ (φ₁ : F₂ →ₙ F₃) (φ₂ : F₁ →ₙ F₂),
{
  map := λ c : C, (φ₁.map c) ∘ₘ (φ₂.map c),
  natural :=
    begin
      intros c c' f,
      rw comp_assoc,
      rw φ₁.natural,
      rw ← comp_assoc,
      rw φ₂.natural,
      rw comp_assoc,
    end,
}

notation φ₁ ` ∘ₙ `:80 φ₂:80 := natural_trans_comp φ₁ φ₂

@[simp]
theorem natural_trans_comp_map {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] {F₁ F₂ F₃: C +→ D}
  (φ₁ : F₂ →ₙ F₃) (φ₂ : F₁ →ₙ F₂) : ∀ c : C, (φ₁ ∘ₙ φ₂).map c = (φ₁.map c) ∘ₘ (φ₂.map c) :=
begin
  intro,
  refl,
end

def idₙ {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D](F : C +→ D) : F →ₙ F :=
{
  map := λ c, idₘ (F.map c),
  natural :=
    begin
      intros c c' f,
      rw id_comp_right,
      rw id_comp_left,
    end,
}

@[simp]
theorem natural_trans_id_map {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] {F : C +→ D}
  : ∀ c : C, (idₙ F).map c = idₘ (F.map c) :=
begin
  intro c,
  refl,
end

def isomorphism {C : Type u} [category.{v} C] {A B : C} : Mor A B → Prop
  := λ f, ∃ g : Mor B A, f ∘ₘ g = idₘ B ∧ g ∘ₘ f = idₘ A

def epimorphism {C : Type u} [category.{v} C] {A₁ A₂ A₃ : C} : Mor A₁ A₂ → Prop
  := λ f, ∀ {g₁ g₂ : Mor A₂ A₃}, g₁ ∘ₘ f = g₂ ∘ₘ f → g₁ = g₂

def monomorphism {C : Type u} [category.{v} C] {A₁ A₂ A₃ : C} : Mor A₂ A₃ → Prop
  := λ f, ∀ {g₁ g₂ : Mor A₁ A₂}, f ∘ₘ g₁ = f ∘ₘ g₂ → g₁ = g₂

end category


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/

import ring_theory.principal_ideal_domain
import order.conditionally_complete_lattice
import ring_theory.multiplicity
import ring_theory.valuation.basic

/-!
# Discrete valuation rings

This file defines discrete valuation rings (DVRs) and develops a basic interface
for them.

## Important definitions

There are various definitions of a DVR in the literature; we define a DVR to be a local PID
which is not a field (the first definition in Wikipedia) and prove that this is equivalent
to being a PID with a unique non-zero prime ideal (the definition in Serre's
book "Local Fields").

Let R be an integral domain, assumed to be a principal ideal ring and a local ring.

* `discrete_valuation_ring R` : a predicate expressing that R is a DVR

### Definitions

* `add_val R : add_valuation R enat` : the additive valuation on a DVR.

## Implementation notes

It's a theorem that an element of a DVR is a uniformizer if and only if it's irreducible.
We do not hence define `uniformizer` at all, because we can use `irreducible` instead.

## Tags

discrete valuation ring
-/

open_locale classical

universe u

open ideal local_ring

/-- An integral domain is a *discrete valuation ring* (DVR) if it's a local PID which
  is not a field. -/
class discrete_valuation_ring (R : Type u) [integral_domain R]
  extends is_principal_ideal_ring R, local_ring R : Prop :=
(not_a_field' : maximal_ideal R ≠ ⊥)

namespace discrete_valuation_ring

variables (R : Type u) [integral_domain R] [discrete_valuation_ring R]

lemma not_a_field : maximal_ideal R ≠ ⊥ := not_a_field'

variable {R}

open principal_ideal_ring

/-- An element of a DVR is irreducible iff it is a uniformizer, that is, generates the
  maximal ideal of R -/
theorem irreducible_iff_uniformizer (ϖ : R) :
  irreducible ϖ ↔ maximal_ideal R = ideal.span {ϖ} :=
⟨λ hϖ, (eq_maximal_ideal (is_maximal_of_irreducible hϖ)).symm,
begin
  intro h,
  have h2 : ¬(is_unit ϖ) := show ϖ ∈ maximal_ideal R,
    from h.symm ▸ submodule.mem_span_singleton_self ϖ,
  refine ⟨h2, _⟩,
  intros a b hab,
  by_contra h,
  push_neg at h,
  obtain ⟨ha : a ∈ maximal_ideal R, hb : b ∈ maximal_ideal R⟩ := h,
  rw h at ha hb,
  rw mem_span_singleton' at ha hb,
  rcases ha with ⟨a, rfl⟩,
  rcases hb with ⟨b, rfl⟩,
  rw (show a * ϖ * (b * ϖ) = ϖ * (ϖ * (a * b)), by ring) at hab,
  have h3 := eq_zero_of_mul_eq_self_right _ hab.symm,
  { apply not_a_field R,
    simp [h, h3] },
  { intro hh, apply h2,
    refine is_unit_of_dvd_one ϖ _,
    use a * b, exact hh.symm }
end⟩

variable (R)

/-- Uniformisers exist in a DVR -/
theorem exists_irreducible : ∃ ϖ : R, irreducible ϖ :=
by {simp_rw [irreducible_iff_uniformizer],
    exact (is_principal_ideal_ring.principal $ maximal_ideal R).principal}

/-- Uniformisers exist in a DVR -/
theorem exists_prime : ∃ ϖ : R, prime ϖ :=
(exists_irreducible R).imp (λ _, principal_ideal_ring.irreducible_iff_prime.1)

/-- an integral domain is a DVR iff it's a PID with a unique non-zero prime ideal -/
theorem iff_pid_with_one_nonzero_prime (R : Type u) [integral_domain R] :
  discrete_valuation_ring R ↔ is_principal_ideal_ring R ∧ ∃! P : ideal R, P ≠ ⊥ ∧ is_prime P :=
begin
  split,
  { intro RDVR,
    rcases id RDVR with ⟨RPID, Rlocal, Rnotafield⟩,
    split, assumption,
    resetI,
    use local_ring.maximal_ideal R,
    split, split,
    { assumption },
    { apply_instance } ,
    { rintro Q ⟨hQ1, hQ2⟩,
      obtain ⟨q, rfl⟩ := (is_principal_ideal_ring.principal Q).1,
      have hq : q ≠ 0,
      { rintro rfl,
        apply hQ1,
        simp },
      erw span_singleton_prime hq at hQ2,
      replace hQ2 := irreducible_of_prime hQ2,
      rw irreducible_iff_uniformizer at hQ2,
      exact hQ2.symm } },
  { rintro ⟨RPID, Punique⟩,
    haveI : local_ring R := local_of_unique_nonzero_prime R Punique,
    refine {not_a_field' := _},
    rcases Punique with ⟨P, ⟨hP1, hP2⟩, hP3⟩,
    have hPM : P ≤ maximal_ideal R := le_maximal_ideal (hP2.1),
    intro h, rw [h, le_bot_iff] at hPM, exact hP1 hPM }
end

lemma associated_of_irreducible {a b : R} (ha : irreducible a) (hb : irreducible b) :
  associated a b :=
begin
  rw irreducible_iff_uniformizer at ha hb,
  rw [←span_singleton_eq_span_singleton, ←ha, hb],
end

end discrete_valuation_ring

namespace discrete_valuation_ring

variable (R : Type*)

/-- Alternative characterisation of discrete valuation rings. -/
def has_unit_mul_pow_irreducible_factorization [integral_domain R] : Prop :=
∃ p : R, irreducible p ∧ ∀ {x : R}, x ≠ 0 → ∃ (n : ℕ), associated (p ^ n) x

namespace has_unit_mul_pow_irreducible_factorization

variables {R} [integral_domain R] (hR : has_unit_mul_pow_irreducible_factorization R)
include hR

lemma unique_irreducible ⦃p q : R⦄ (hp : irreducible p) (hq : irreducible q) :
  associated p q :=
begin
  rcases hR with ⟨ϖ, hϖ, hR⟩,
  suffices : ∀ {p : R} (hp : irreducible p), associated p ϖ,
  { apply associated.trans (this hp) (this hq).symm, },
  clear hp hq p q,
  intros p hp,
  obtain ⟨n, hn⟩ := hR hp.ne_zero,
  have : irreducible (ϖ ^ n) := irreducible_of_associated hn.symm hp,
  rcases lt_trichotomy n 1 with (H|rfl|H),
  { obtain rfl : n = 0, { clear hn this, revert H n, exact dec_trivial },
    simpa only [not_irreducible_one, pow_zero] using this, },
  { simpa only [pow_one] using hn.symm, },
  { obtain ⟨n, rfl⟩ : ∃ k, n = 1 + k + 1 := nat.exists_eq_add_of_lt H,
    rw pow_succ at this,
    rcases this.is_unit_or_is_unit rfl with H0|H0,
    { exact (hϖ.not_unit H0).elim, },
    { rw [add_comm, pow_succ] at H0,
      exact (hϖ.not_unit (is_unit_of_mul_is_unit_left H0)).elim } }
end

/-- An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p` is a unique factorization domain.
See `discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization`. -/
theorem to_unique_factorization_monoid : unique_factorization_monoid R :=
let p := classical.some hR in
let spec := classical.some_spec hR in
unique_factorization_monoid.of_exists_prime_factors $ λ x hx,
begin
  use multiset.repeat p (classical.some (spec.2 hx)),
  split,
  { intros q hq,
    have hpq := multiset.eq_of_mem_repeat hq,
    rw hpq,
    refine ⟨spec.1.ne_zero, spec.1.not_unit, _⟩,
    intros a b h,
    by_cases ha : a = 0,
    { rw ha, simp only [true_or, dvd_zero], },
    by_cases hb : b = 0,
    { rw hb, simp only [or_true, dvd_zero], },
    obtain ⟨m, u, rfl⟩ := spec.2 ha,
    rw [mul_assoc, mul_left_comm, is_unit.dvd_mul_left _ _ _ (units.is_unit _)] at h,
    rw is_unit.dvd_mul_right (units.is_unit _),
    by_cases hm : m = 0,
    { simp only [hm, one_mul, pow_zero] at h ⊢, right, exact h },
    left,
    obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero hm,
    rw pow_succ,
    apply dvd_mul_of_dvd_left (dvd_refl _) _ },
  { rw [multiset.prod_repeat], exact (classical.some_spec (spec.2 hx)), }
end

omit hR

lemma of_ufd_of_unique_irreducible [unique_factorization_monoid R]
  (h₁ : ∃ p : R, irreducible p)
  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
  has_unit_mul_pow_irreducible_factorization R :=
begin
  obtain ⟨p, hp⟩ := h₁,
  refine ⟨p, hp, _⟩,
  intros x hx,
  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
  refine ⟨fx.card, _⟩,
  have H := hfx.2,
  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_repeat],
  congr' 1,
  symmetry,
  rw multiset.eq_repeat,
  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
    multiset.mem_map, exists_imp_distrib],
  rintros _ q hq rfl,
  rw associates.mk_eq_mk_iff_associated,
  apply h₂ (hfx.1 _ hq) hp,
end

end has_unit_mul_pow_irreducible_factorization

lemma aux_pid_of_ufd_of_unique_irreducible
  (R : Type u) [integral_domain R] [unique_factorization_monoid R]
  (h₁ : ∃ p : R, irreducible p)
  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
  is_principal_ideal_ring R :=
begin
  constructor,
  intro I,
  by_cases I0 : I = ⊥, { rw I0, use 0, simp only [set.singleton_zero, submodule.span_zero], },
  obtain ⟨x, hxI, hx0⟩ : ∃ x ∈ I, x ≠ (0:R) := I.ne_bot_iff.mp I0,
  obtain ⟨p, hp, H⟩ :=
    has_unit_mul_pow_irreducible_factorization.of_ufd_of_unique_irreducible h₁ h₂,
  have ex : ∃ n : ℕ, p ^ n ∈ I,
  { obtain ⟨n, u, rfl⟩ := H hx0,
    refine ⟨n, _⟩,
    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hxI, },
  constructor,
  use p ^ (nat.find ex),
  show I = ideal.span _,
  apply le_antisymm,
  { intros r hr,
    by_cases hr0 : r = 0,
    { simp only [hr0, submodule.zero_mem], },
    obtain ⟨n, u, rfl⟩ := H hr0,
    simp only [mem_span_singleton, units.is_unit, is_unit.dvd_mul_right],
    apply pow_dvd_pow,
    apply nat.find_min',
    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hr, },
  { erw submodule.span_singleton_le_iff_mem,
    exact nat.find_spec ex, },
end

/--
A unique factorization domain with at least one irreducible element
in which all irreducible elements are associated
is a discrete valuation ring.
-/
lemma of_ufd_of_unique_irreducible {R : Type u} [integral_domain R] [unique_factorization_monoid R]
  (h₁ : ∃ p : R, irreducible p)
  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
  discrete_valuation_ring R :=
begin
  rw iff_pid_with_one_nonzero_prime,
  haveI PID : is_principal_ideal_ring R := aux_pid_of_ufd_of_unique_irreducible R h₁ h₂,
  obtain ⟨p, hp⟩ := h₁,
  refine ⟨PID, ⟨ideal.span {p}, ⟨_, _⟩, _⟩⟩,
  { rw submodule.ne_bot_iff,
    refine ⟨p, ideal.mem_span_singleton.mpr (dvd_refl p), hp.ne_zero⟩, },
  { rwa [ideal.span_singleton_prime hp.ne_zero,
        ← unique_factorization_monoid.irreducible_iff_prime], },
  { intro I,
    rw ← submodule.is_principal.span_singleton_generator I,
    rintro ⟨I0, hI⟩,
    apply span_singleton_eq_span_singleton.mpr,
    apply h₂ _ hp,
    erw [ne.def, span_singleton_eq_bot] at I0,
    rwa [unique_factorization_monoid.irreducible_iff_prime, ← ideal.span_singleton_prime I0], },
end

/--
An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p`
is a discrete valuation ring.
-/
lemma of_has_unit_mul_pow_irreducible_factorization {R : Type u} [integral_domain R]
  (hR : has_unit_mul_pow_irreducible_factorization R) :
  discrete_valuation_ring R :=
begin
  letI : unique_factorization_monoid R := hR.to_unique_factorization_monoid,
  apply of_ufd_of_unique_irreducible _ hR.unique_irreducible,
  unfreezingI { obtain ⟨p, hp, H⟩ := hR, exact ⟨p, hp⟩, },
end

section

variables [integral_domain R] [discrete_valuation_ring R]

variable {R}

lemma associated_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
  ∃ (n : ℕ), associated x (ϖ ^ n) :=
begin
  have : wf_dvd_monoid R := is_noetherian_ring.wf_dvd_monoid,
  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
  unfreezingI { use fx.card },
  have H := hfx.2,
  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_repeat],
  congr' 1,
  rw multiset.eq_repeat,
  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
             multiset.mem_map, exists_imp_distrib],
  rintros _ _ _ rfl,
  rw associates.mk_eq_mk_iff_associated,
  refine associated_of_irreducible _ _ hirr,
  apply hfx.1,
  assumption
end

lemma eq_unit_mul_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
  ∃ (n : ℕ) (u : units R), x = u * ϖ ^ n :=
begin
  obtain ⟨n, hn⟩ := associated_pow_irreducible hx hirr,
  obtain ⟨u, rfl⟩ := hn.symm,
  use [n, u],
  apply mul_comm,
end

open submodule.is_principal

lemma ideal_eq_span_pow_irreducible {s : ideal R} (hs : s ≠ ⊥) {ϖ : R} (hirr : irreducible ϖ) :
  ∃ n : ℕ, s = ideal.span {ϖ ^ n} :=
begin
  have gen_ne_zero : generator s ≠ 0,
  { rw [ne.def, ← eq_bot_iff_generator_eq_zero], assumption },
  rcases associated_pow_irreducible gen_ne_zero hirr with ⟨n, u, hnu⟩,
  use n,
  have : span _ = _ := span_singleton_generator s,
  rw [← this, ← hnu, span_singleton_eq_span_singleton],
  use u
end

lemma unit_mul_pow_congr_pow {p q : R} (hp : irreducible p) (hq : irreducible q)
  (u v : units R) (m n : ℕ) (h : ↑u * p ^ m = v * q ^ n) :
  m = n :=
begin
  have key : associated (multiset.repeat p m).prod (multiset.repeat q n).prod,
  { rw [multiset.prod_repeat, multiset.prod_repeat, associated],
    refine ⟨u * v⁻¹, _⟩,
    simp only [units.coe_mul],
    rw [mul_left_comm, ← mul_assoc, h, mul_right_comm, units.mul_inv, one_mul], },
  have := multiset.card_eq_card_of_rel (unique_factorization_monoid.factors_unique _ _ key),
  { simpa only [multiset.card_repeat] },
  all_goals
  { intros x hx, replace hx := multiset.eq_of_mem_repeat hx,
    unfreezingI { subst hx, assumption } },
end

lemma unit_mul_pow_congr_unit {ϖ : R} (hirr : irreducible ϖ) (u v : units R) (m n : ℕ)
  (h : ↑u * ϖ ^ m = v * ϖ ^ n) :
  u = v :=
begin
  obtain rfl : m = n := unit_mul_pow_congr_pow hirr hirr u v m n h,
  rw ← sub_eq_zero at h,
  rw [← sub_mul, mul_eq_zero] at h,
  cases h,
  { rw sub_eq_zero at h, exact_mod_cast h },
  { apply (hirr.ne_zero (pow_eq_zero h)).elim, }
end

/-!
## The additive valuation on a DVR
-/

open multiplicity

/-- The `enat`-valued additive valuation on a DVR -/
noncomputable def add_val (R : Type u) [integral_domain R] [discrete_valuation_ring R] :
  add_valuation R enat :=
add_valuation (classical.some_spec (exists_prime R))

lemma add_val_def (r : R) (u : units R) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) (hr : r = u * ϖ ^ n) :
  add_val R r = n :=
by rw [add_val, add_valuation_apply, hr,
    eq_of_associated_left (associated_of_irreducible R hϖ
      (irreducible_of_prime (classical.some_spec (exists_prime R)))),
    eq_of_associated_right (associated.symm ⟨u, mul_comm _ _⟩),
    multiplicity_pow_self_of_prime (principal_ideal_ring.irreducible_iff_prime.1 hϖ)]

lemma add_val_def' (u : units R) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) :
  add_val R ((u : R) * ϖ ^ n) = n :=
add_val_def _ u hϖ n rfl

@[simp] lemma add_val_zero : add_val R 0 = ⊤ :=
(add_val R).map_zero

@[simp] lemma add_val_one : add_val R 1 = 0 :=
(add_val R).map_one

@[simp] lemma add_val_uniformizer {ϖ : R} (hϖ : irreducible ϖ) : add_val R ϖ = 1 :=
add_val_def ϖ 1 hϖ 1 (by simp)

@[simp] lemma add_val_mul {a b : R} :
  add_val R (a * b) = add_val R a + add_val R b :=
(add_val R).map_mul _ _

lemma add_val_pow (a : R) (n : ℕ) : add_val R (a ^ n) = n • add_val R a :=
(add_val R).map_pow _ _

lemma add_val_eq_top_iff {a : R} : add_val R a = ⊤ ↔ a = 0 :=
begin
  have hi := (irreducible_of_prime (classical.some_spec (exists_prime R))),
  split,
  { contrapose,
    intro h,
    obtain ⟨n, ha⟩ := associated_pow_irreducible h hi,
    obtain ⟨u, rfl⟩ := ha.symm,
    rw [mul_comm, add_val_def' u hi n],
    exact enat.coe_ne_top _ },
  { rintro rfl,
    exact add_val_zero }
end

lemma add_val_le_iff_dvd {a b : R} : add_val R a ≤ add_val R b ↔ a ∣ b :=
begin
  have hp := classical.some_spec (exists_prime R),
  split; intro h,
  { by_cases ha0 : a = 0,
    { rw [ha0, add_val_zero, top_le_iff, add_val_eq_top_iff] at h,
      rw h,
      apply dvd_zero },
    obtain ⟨n, ha⟩ := associated_pow_irreducible ha0 (irreducible_of_prime hp),
    rw [add_val, add_valuation_apply, add_valuation_apply,
      multiplicity_le_multiplicity_iff] at h,
    exact dvd.trans (dvd_of_associated ha) (h n (dvd_of_associated ha.symm)), },
  { rw [add_val, add_valuation_apply, add_valuation_apply],
    exact multiplicity_le_multiplicity_of_dvd_right h }
end

lemma add_val_add {a b : R} :
  min (add_val R a) (add_val R b) ≤ add_val R (a + b) :=
(add_val R).map_add _ _

end

end discrete_valuation_ring


import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Int.Basic
import Mathlib.Tactic.Basic

/-!
## Basic Tactics

We already saw the `intros` and `apply` tactics. These are the staples of tactical
proofs. Other basic tactics include `rfl`, `exact`, `assumption`, and `cc`. These tactics
can go a long way, if we are patient enough to carry out the reasoning using them,
without appealing to stronger proof automation. They can also be used to solve
various logic puzzles.

Below, the square brackets [] enclose optional syntax

**intro(s)**

```
    intro [ name ]
    intros [ name₁ ... nameₙ ]
```

The `intro` tactic moves the leading ∀-quantified variable or the leading assumption `a →` from the
goal’s target to the local context. The tactic takes as an optional argument the name to give to the
variable or to the assumption in the context, overriding the default name. The plural variant intros
can be used to move several variables or assumptions at once.

**rfl**

The `rfl` tactic proves goals of the form `⊢ l = r`, where the two sides `l` and `r` are
syntactically equal up to computation. Computation means expansion of definitions, reduction of an
application of a λ-expression to an argument, and more.

These _conversions_ have traditional names. The main conversions are listed below together with
examples, in a global context containing `def double (n : ℕ) : ℕ := n + n`:

| name         | effect                               |
|--------------|--------------------------------------|
| α-conversion | `(λx => f x) = (λy => f y)`              |
| β-conversion | `(λx => f x) a = f a`                  |
| δ-conversion | `double 5 = 5 + 5`                   |
| ζ-conversion | `(let n : N := 2 ; n + n) = 4`      |
| η-conversion | `(λx => f x) = f`                      |
| ι-conversion | `prod.fst (a, b) = a`                |

Applying a conversion repeatedly as left-to-right rewrite rules is called _reduction); applying it
once in reverse is called _expansion_. Since much of Lean’s machinery treats terms that are
syntactically equal up to computation uniformly, it usually makes sense to tell Lean’s
pretty-printer to aggressively β-reduce its output. This is what the the command
```
set_option pp.beta true   -- BUGBUG: https://github.com/leanprover/lean4/issues/715
```
near the top of the files accompanying this guide achieves.
-/

lemma α_example {α β : Type} (f : α → β) :
  (λ x => f x) = (λ y => f y) :=
  by
   rfl

lemma α_example₂ {α β : Type} (f : α → β) :
  (λx => f x) = (λy => f y) :=
by rfl

lemma β_example {α β : Type} (f : α → β) (a : α) :
  (λx => f x) a = f a :=
by rfl

def double (n : ℕ) : ℕ := n + n

lemma δ_example :
  double 5 = 5 + 5 :=
by rfl

lemma ζ_example :
  (let n : ℕ := 2; n + n) = 4 :=
by rfl

lemma η_example {α β : Type} (f : α → β) :
  (λ x => f x) = f :=
by rfl

lemma ι_example {α β : Type} (a : α) (b : β) :
  Prod.fst (a, b) = a :=
by rfl
/-!

**apply**
```
    apply lemma-or-hypothesis
```

The `apply` tactic matches the goal’s target with the conclusion of the specified lemma or
hypothesis and adds the lemma or hypothesis’s assumptions as new goals. The matching is performed up
to computation.

We must invoke apply with care, because it can transform a provable goal into
an unprovable subgoal. For example, if the goal is `⊢ 2 + 2 = 4` and we apply the
lemma `false → ?a`, the variable `?a` is matched against `2 + 2 = 4`, and we end up
with the unprovable subgoal `⊢ false`. We say that `apply` is unsafe. In contrast,
`intro` always preserves provability and is therefore safe.

**exact**
    ```
    exact lemma-or-hypothesis
    ```

The `exact` tactic matches the goal’s target with the specified lemma or hypothesis,
closing the goal. We can often use `apply` in such situations, but `exact` communicates
our intentions better. In the example from Section 2.1, we could have used
`exact ha` instead of `apply ha`.

**assumption**

The `assumption` tactic finds a hypothesis from the local context that matches the
goal’s target and applies it to prove the goal. In the example from Section 2.1, we
could have used `assumption` instead of `apply ha`

**cc**

The `cc` tactic implements an algorithm known as [congruence closure](../bib.md#31) to derive new
equalities from those that are present in the goal. For example, if the goal contains `b = a` and
`f b ≠ f a` as hypotheses, the algorithm will derive `f b = f a` from `b = a` and discover a contradiction
with `f b ≠ f a`. The `cc` tactic is also suitable for more pedestrian work, such as proving
`hb : b ⊢ a ∨ b ∨ c` or discovering a contradiction among the goal’s hypotheses.

In addition, `cc` can be used to reason up to associativity (e.g., `(a + b) + c = a + (b + c)`) and
commutativity (e.g, `a + b = b + a`). This works for binary operations that are registered as
associative and commutative, such as `+` and `*` on arithmetic types, and `∪` and `∩` on sets. We will see
an example in Section 2.6.

At this point, you might wonder, “So what does `cc` do exactly?” Of course, you could look up the
[reference](../bib.md#31) given above to the scientific paper that describes its underlying algorithm, or even
read the source code. But this might not be the most efficient use of your time. In truth, even expert
users of proof assistants do not fully understand the behavior of the tactics they use daily. The
most successful users adopt a relaxed, sporty attitude, trying tactics in sequence and studying the
emerging subgoals, if any, to see if they are on the right path.

As you keep on using `cc` and other tactics, you will develop some intuition about what kinds of
goal they work well on. This is one of the many reasons why interactive theorem proving can only be
learned by doing. Often, you will not understand exactly what Lean does—why a tactic succeeds, or
fails. Theorem proving can be very frustrating at times. The advice printed in large, friendly
letters on the cover of _The Hitchhiker’s Guide to the Galaxy_ applies here: DON'T PANIC.

**sorry**

The `sorry` proof command we encountered in [Theorem Statements](../Basics/TheoremStatements.lean.md)
is also available as a tactic. It “proves” the current goal without actually proving it. This is
normally used as a placeholder for a proof that is not yet available or an exercise left to the reader.

-/


import GMLInit.Data.Nat.Basic
import GMLInit.Data.Nat.IsPos
import GMLInit.Data.Nat.Order
import GMLInit.Data.Nat.Succ
import GMLInit.Data.Nat.Add
import GMLInit.Data.Nat.Sub
import GMLInit.Data.Nat.Mul

namespace Nat

attribute [local eliminator] Nat.recDiagAux

-- assert theorem pow_zero (x : Nat) : x ^ 0 = 1

protected theorem pow_one (x : Nat) : x ^ 1 = x :=
  calc
  _ = x ^ 0 * x := by rw [Nat.pow_succ]
  _ = 1 * x := by rw [Nat.pow_zero]
  _ = x := by rw [Nat.one_mul]

protected theorem one_pow (x : Nat) : 1 ^ x = 1 := by
  induction x with
  | zero => rw [Nat.pow_zero]
  | succ x H =>
    calc
    _ = 1 ^ (x + 1) := rfl
    _ = 1 ^ x * 1 := by rw [Nat.pow_succ]
    _ = 1 * 1 := by rw [H]
    _ = 1 := by rw [Nat.mul_one]

protected theorem zero_pow_succ (x : Nat) : 0 ^ (x + 1) = 0 :=
  calc
  _ = 0 ^ x * 0 := by rw [Nat.pow_succ]
  _ = 0 := by rw [Nat.mul_zero]

protected theorem zero_pow_of_nonzero {x : Nat} : x ≠ 0 → 0 ^ x = 0 := by
  cases x with
  | zero => intro; contradiction
  | succ x => intro; rw [Nat.zero_pow_succ]

protected theorem zero_pow (x : Nat) : (h : x ≠ 0 := by nat_is_nonzero) → 0 ^ x = 0 := Nat.zero_pow_of_nonzero

protected theorem pow_add (x y z : Nat) : x ^ (y + z) = x ^ y * x ^ z := by
  induction z with
  | zero => rw [Nat.pow_zero, Nat.add_zero, Nat.mul_one]
  | succ z H => rw [Nat.pow_succ, Nat.add_succ, Nat.pow_succ, H, Nat.mul_assoc]

protected theorem mul_pow (x y z : Nat) : (x * y) ^ z = x ^ z * y ^ z := by
  induction z with
  | zero => rw [Nat.pow_zero, Nat.pow_zero, Nat.pow_zero, Nat.mul_one]
  | succ z H => rw [Nat.pow_succ, Nat.pow_succ, Nat.pow_succ, H, Nat.mul_cross_comm]

protected theorem pow_assoc (x y z : Nat) : (x ^ y) ^ z = x ^ (y * z) := by
  induction z with
  | zero => rw [Nat.pow_zero, Nat.mul_zero, Nat.pow_zero]
  | succ z H => rw [Nat.pow_succ, Nat.mul_succ, Nat.pow_add, H]

protected theorem pow_right_comm (x y z : Nat) : (x ^ y) ^ z = (x ^ z) ^ y := by
  rw [Nat.pow_assoc, Nat.mul_comm, ←Nat.pow_assoc]

-- assert theorem pos_pow_of_pos {x : Nat} (y : Nat) : x > 0 → x ^ y > 0

protected theorem le_pow_right_of_pos {x y : Nat} : y > 0 → x ≤ x ^ y := by
  cases x, y with
  | left x => intro; contradiction
  | right y => intro; apply Nat.zero_le
  | diag x y =>
    intro
    transitivity (1 * (x + 1)) using Eq, LE.le
    · rw [Nat.one_mul]
    · rw [Nat.pow_succ]
      apply Nat.mul_le_mul_right
      apply Nat.succ_le_of_lt
      apply Nat.pos_pow_of_pos
      apply Nat.zero_lt_succ

protected theorem le_pow_right (x y : Nat) : (h : y > 0 := by nat_is_pos) → x ≤ x ^ y := Nat.le_pow_right_of_pos

protected theorem pow_le_pow_left {x y : Nat} (h : x ≤ y) (z : Nat) : x ^ z ≤ y ^ z :=
  Nat.pow_le_pow_of_le_left h z

protected theorem pow_le_pow_of_pos_left {x y : Nat} (h : x ≤ y) {z : Nat} : z > 0 → z ^ x ≤ z ^ y :=
  λ hz => Nat.pow_le_pow_of_le_right hz h

protected theorem pow_lt_pow_of_pos_right {x y : Nat} (h : x < y) {z : Nat} : z > 0 → x ^ z < y ^ z := by
  cases z with
  | zero => intro; contradiction
  | succ z =>
    intro
    rw [Nat.pow_succ, Nat.pow_succ]
    apply Nat.mul_lt_mul_of_le_of_lt
    · apply Nat.pow_le_pow_left
      apply Nat.le_of_lt
      exact h
    · exact h
    · apply Nat.pos_pow_of_pos
      transitivity x using LE.le, LT.lt
      · apply Nat.zero_le
      · exact h

protected theorem pow_lt_pow_of_gt_one_left {x y : Nat} (h : x < y) {z : Nat} : z > 1 → z ^ x < z ^ y := by
  induction x, y with
  | left x => intro; contradiction
  | right y =>
    intro hz
    transitivity z using LT.lt, LE.le
    · rw [Nat.pow_zero]
      exact hz
    · exact Nat.le_pow_right _ _
  | diag x y H =>
    intro hz
    rw [Nat.pow_succ, Nat.pow_succ]
    apply Nat.mul_lt_mul_of_pos_right
    apply H
    · exact Nat.lt_of_succ_lt_succ h
    · exact hz
    · transitivity 1 using LT.lt
      · exact Nat.zero_lt_one
      · exact hz

end Nat


/-
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.order
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Dfinsupp.Basic

/-!
# Pointwise order on finitely supported dependent functions

This file lifts order structures on the `α i` to `Π₀ i, α i`.

## Main declarations

* `Dfinsupp.orderEmbeddingToFun`: The order embedding from finitely supported dependent functions
  to functions.

-/

open BigOperators

open Finset

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

namespace Dfinsupp

/-! ### Order structures -/

section Zero

-- porting note: The unusedVariables linter has false positives in code like
--    variable (α) [∀ i, Zero (α i)]
-- marking the `i` as unused. The linter is fine when the code is split into 2 lines.
-- Likely issue https://github.com/leanprover/lean4/issues/2088, so combine lines when that is fixed
variable (α)
variable [∀ i, Zero (α i)]

section LE

variable [∀ i, LE (α i)]

instance : LE (Π₀ i, α i) :=
  ⟨fun f g ↦ ∀ i, f i ≤ g i⟩

variable {α}

theorem le_def {f g : Π₀ i, α i} : f ≤ g ↔ ∀ i, f i ≤ g i :=
  Iff.rfl
#align dfinsupp.le_def Dfinsupp.le_def

/-- The order on `Dfinsupp`s over a partial order embeds into the order on functions -/
def orderEmbeddingToFun : (Π₀ i, α i) ↪o ∀ i, α i
    where
  toFun := FunLike.coe
  inj' := FunLike.coe_injective
  map_rel_iff' := by rfl
#align dfinsupp.order_embedding_to_fun Dfinsupp.orderEmbeddingToFun

@[simp]
theorem orderEmbeddingToFun_apply {f : Π₀ i, α i} {i : ι} : orderEmbeddingToFun f i = f i :=
  rfl
#align dfinsupp.order_embedding_to_fun_apply Dfinsupp.orderEmbeddingToFun_apply

end LE

section Preorder

variable [∀ i, Preorder (α i)]

instance : Preorder (Π₀ i, α i) :=
  { (inferInstance : LE (Dfinsupp α)) with
    le_refl := fun f i ↦ le_rfl
    le_trans := fun f g h hfg hgh i ↦ (hfg i).trans (hgh i) }

theorem coeFn_mono : Monotone (FunLike.coe : (Π₀ i, α i) → ∀ i, α i) := fun _ _ ↦ le_def.1
#align dfinsupp.coe_fn_mono Dfinsupp.coeFn_mono

end Preorder

instance [∀ i, PartialOrder (α i)] : PartialOrder (Π₀ i, α i) :=
  { (inferInstance : Preorder (Dfinsupp α)) with
    le_antisymm := fun _ _ hfg hgf ↦ ext fun i ↦ (hfg i).antisymm (hgf i) }

instance [∀ i, SemilatticeInf (α i)] : SemilatticeInf (Π₀ i, α i) :=
  { (inferInstance : PartialOrder (Dfinsupp α)) with
    inf := zipWith (fun _ ↦ (· ⊓ ·)) fun _ ↦ inf_idem
    inf_le_left := fun _ _ _ ↦ inf_le_left
    inf_le_right := fun _ _ _ ↦ inf_le_right
    le_inf := fun _ _ _ hf hg i ↦ le_inf (hf i) (hg i) }

@[simp]
theorem inf_apply [∀ i, SemilatticeInf (α i)] (f g : Π₀ i, α i) (i : ι) : (f ⊓ g) i = f i ⊓ g i :=
  zipWith_apply _ _ _ _ _
#align dfinsupp.inf_apply Dfinsupp.inf_apply

instance [∀ i, SemilatticeSup (α i)] : SemilatticeSup (Π₀ i, α i) :=
  { (inferInstance : PartialOrder (Dfinsupp α)) with
    sup := zipWith (fun _ ↦ (· ⊔ ·)) fun _ ↦ sup_idem
    le_sup_left := fun _ _ _ ↦ le_sup_left
    le_sup_right := fun _ _ _ ↦ le_sup_right
    sup_le := fun _ _ _ hf hg i ↦ sup_le (hf i) (hg i) }

@[simp]
theorem sup_apply [∀ i, SemilatticeSup (α i)] (f g : Π₀ i, α i) (i : ι) : (f ⊔ g) i = f i ⊔ g i :=
  zipWith_apply _ _ _ _ _
#align dfinsupp.sup_apply Dfinsupp.sup_apply

instance lattice [∀ i, Lattice (α i)] : Lattice (Π₀ i, α i) :=
  { (inferInstance : SemilatticeInf (Dfinsupp α)),
    (inferInstance : SemilatticeSup (Dfinsupp α)) with }
#align dfinsupp.lattice Dfinsupp.lattice

end Zero

/-! ### Algebraic order structures -/

instance (α : ι → Type _) [∀ i, OrderedAddCommMonoid (α i)] : OrderedAddCommMonoid (Π₀ i, α i) :=
  { (inferInstance : AddCommMonoid (Dfinsupp α)),
    (inferInstance : PartialOrder (Dfinsupp α)) with
    add_le_add_left := fun _ _ h c i ↦ add_le_add_left (h i) (c i) }

instance (α : ι → Type _) [∀ i, OrderedCancelAddCommMonoid (α i)] :
    OrderedCancelAddCommMonoid (Π₀ i, α i) :=
  { (inferInstance : OrderedAddCommMonoid (Dfinsupp α)) with
    le_of_add_le_add_left := fun _ _ _ H i ↦ le_of_add_le_add_left (H i) }

instance [∀ i, OrderedAddCommMonoid (α i)] [∀ i, ContravariantClass (α i) (α i) (· + ·) (· ≤ ·)] :
    ContravariantClass (Π₀ i, α i) (Π₀ i, α i) (· + ·) (· ≤ ·) :=
  ⟨fun _ _ _ H i ↦ le_of_add_le_add_left (H i)⟩

section CanonicallyOrderedAddMonoid

-- porting note: Split into 2 lines to satisfy the unusedVariables linter.
variable (α)
variable [∀ i, CanonicallyOrderedAddMonoid (α i)]

instance : OrderBot (Π₀ i, α i) where
  bot := 0
  bot_le := by simp only [le_def, coe_zero, Pi.zero_apply, imp_true_iff, zero_le]

variable {α}

protected theorem bot_eq_zero : (⊥ : Π₀ i, α i) = 0 :=
  rfl
#align dfinsupp.bot_eq_zero Dfinsupp.bot_eq_zero

@[simp]
theorem add_eq_zero_iff (f g : Π₀ i, α i) : f + g = 0 ↔ f = 0 ∧ g = 0 := by
  simp [FunLike.ext_iff, forall_and]
#align dfinsupp.add_eq_zero_iff Dfinsupp.add_eq_zero_iff

section Le

variable [DecidableEq ι] [∀ (i) (x : α i), Decidable (x ≠ 0)] {f g : Π₀ i, α i} {s : Finset ι}

theorem le_iff' (hf : f.support ⊆ s) : f ≤ g ↔ ∀ i ∈ s, f i ≤ g i :=
  ⟨fun h s _ ↦ h s, fun h s ↦
    if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩
#align dfinsupp.le_iff' Dfinsupp.le_iff'

variable (α)

instance decidableLe [∀ i, DecidableRel (@LE.le (α i) _)] : DecidableRel (@LE.le (Π₀ i, α i) _) :=
  fun _ _ ↦ decidable_of_iff _ le_iff.symm
#align dfinsupp.decidable_le Dfinsupp.decidableLe

variable {α}

@[simp]
theorem single_le_iff {i : ι} {a : α i} : single i a ≤ f ↔ a ≤ f i :=
  (le_iff' support_single_subset).trans <| by simp
#align dfinsupp.single_le_iff Dfinsupp.single_le_iff

end Le

-- porting note: Split into 2 lines to satisfy the unusedVariables linter.
variable (α)
variable [∀ i, Sub (α i)] [∀ i, OrderedSub (α i)] {f g : Π₀ i, α i} {i : ι} {a b : α i}

/-- This is called `tsub` for truncated subtraction, to distinguish it with subtraction in an
additive group. -/
instance tsub : Sub (Π₀ i, α i) :=
  ⟨zipWith (fun _ m n ↦ m - n) fun _ ↦ tsub_self 0⟩
#align dfinsupp.tsub Dfinsupp.tsub

variable {α}

theorem tsub_apply (f g : Π₀ i, α i) (i : ι) : (f - g) i = f i - g i :=
  zipWith_apply _ _ _ _ _
#align dfinsupp.tsub_apply Dfinsupp.tsub_apply

@[simp]
theorem coe_tsub (f g : Π₀ i, α i) : ⇑(f - g) = f - g := by
  ext i
  exact tsub_apply f g i
#align dfinsupp.coe_tsub Dfinsupp.coe_tsub

variable (α)

instance : OrderedSub (Π₀ i, α i) :=
  ⟨fun _ _ _ ↦ forall_congr' fun _ ↦ tsub_le_iff_right⟩

instance : CanonicallyOrderedAddMonoid (Π₀ i, α i) :=
  { (inferInstance : OrderBot (Dfinsupp α)),
    (inferInstance : OrderedAddCommMonoid (Dfinsupp α)) with
    exists_add_of_le := by
      intro f g h
      exists g - f
      ext i
      exact (add_tsub_cancel_of_le <| h i).symm
    le_self_add := fun _ _ _ ↦ le_self_add }

variable {α} [DecidableEq ι]

@[simp]
theorem single_tsub : single i (a - b) = single i a - single i b := by
  ext j
  obtain rfl | h := eq_or_ne i j
  · rw [tsub_apply, single_eq_same, single_eq_same, single_eq_same]
  · rw [tsub_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, tsub_self]
#align dfinsupp.single_tsub Dfinsupp.single_tsub

variable [∀ (i) (x : α i), Decidable (x ≠ 0)]

theorem support_tsub : (f - g).support ⊆ f.support := by
  simp (config := { contextual := true }) only [subset_iff, tsub_eq_zero_iff_le, mem_support_iff,
    Ne.def, coe_tsub, Pi.sub_apply, not_imp_not, zero_le, imp_true_iff]
#align dfinsupp.support_tsub Dfinsupp.support_tsub

theorem subset_support_tsub : f.support \ g.support ⊆ (f - g).support := by
  simp (config := { contextual := true }) [subset_iff]
#align dfinsupp.subset_support_tsub Dfinsupp.subset_support_tsub

end CanonicallyOrderedAddMonoid

section CanonicallyLinearOrderedAddMonoid

variable [∀ i, CanonicallyLinearOrderedAddMonoid (α i)] [DecidableEq ι] {f g : Π₀ i, α i}

@[simp]
theorem support_inf : (f ⊓ g).support = f.support ∩ g.support := by
  ext
  simp only [inf_apply, mem_support_iff, Ne.def, Finset.mem_inter]
  simp only [inf_eq_min, ← nonpos_iff_eq_zero, min_le_iff, not_or]
#align dfinsupp.support_inf Dfinsupp.support_inf

@[simp]
theorem support_sup : (f ⊔ g).support = f.support ∪ g.support := by
  ext
  simp only [Finset.mem_union, mem_support_iff, sup_apply, Ne.def, ← bot_eq_zero]
  rw [_root_.sup_eq_bot_iff, not_and_or]
#align dfinsupp.support_sup Dfinsupp.support_sup

nonrec theorem disjoint_iff : Disjoint f g ↔ Disjoint f.support g.support := by
  rw [disjoint_iff, disjoint_iff, Dfinsupp.bot_eq_zero, ← Dfinsupp.support_eq_empty,
    Dfinsupp.support_inf]
  rfl
#align dfinsupp.disjoint_iff Dfinsupp.disjoint_iff

end CanonicallyLinearOrderedAddMonoid

end Dfinsupp


import Mathlib.Tactic.Basic
import Mathlib.Init.Data.Nat.Basic
/-!
## Dependent Types

Dependent types are the defining feature of the _dependent type theory_ family of
logics. Although you may not be familiar with the terminology, you are likely to
be familiar with the concept in some form or other.

Consider a function `pick` that takes a natural number `n` (i.e, a value from
`ℕ = {0, 1, 2, . . .}`) and that returns a natural number between `0` and `n`.
Intuitively, `pick n` should have the type `{0, 1, . . ., n}` (i.e., the type consisting
of all natural numbers `i ≤ n`). In Lean, this is written `{i : N // i ≤ n}`.
This would be the type of `pick n`. Mathematically inclined readers might want to
think of `pick` as an ℕ-indexed family of terms
```
(pick n : {i : ℕ // i ≤ n})ₙ
```
--BUGBUG : markdown won't let me subscript `n:ℕ` like the book has.

in which the type of each term depends on the index—e.g.,
`pick 5 : {i : ℕ // i ≤ 5}`. But what would be the type of `pick` itself? We would like to express that
`pick` is a function that takes an argument `n : ℕ` and that returns a value of type
`{i : ℕ // i ≤ n}`. To capture this, we can write
-/
def pick : (n : ℕ) → {i : ℕ // i ≤ n} :=
  sorry
/-!
This is a dependent type: The type of the result depends on the value of the
argument `n`. The variable name `n` is immaterial.

Unless otherwise specified, a _dependent type_ means a type depending on a (non-type) term, as above,
with `n : ℕ` as the term and `{i : ℕ // i ≤ n}` as the type that depends on it. This is what we mean
when we claim that simple type theory does not support dependent types. But a type may also depend
on another type— for example, the type constructor `List`, its η-expanded variant `λ α : Type => List α`,
or the polymorphic type `λ α : Type => α → α` of functions with the same domain and codomain. A term may
depend on a type—for example, the polymorphic identity function `λ α : Type => λ x : α => x`. And of course,
a term may also depend on a term— for example, `λ n : ℕ => n + 2`. In summary, there are four cases for
`λ x => t`:

| Body (t)  |                 | Argument (x) | Description                         |
|-----------|-----------------|--------------|-------------------------------------|
| A term    | depending on    | a term       |Simply typed λ-expression            |
| A type    | depending on    | a term       |Dependent type (in the narrow sense) |
| A term    | depending on    | a type       |Polymorphic term                     |
| A type    | depending on    | a type       |Type constructor                     |

The last three rows correspond to the three axes of [Henk Barendregt’s λ-cube](https://en.wikipedia.org/wiki/Lambda_cube).

The APP and LAM rules presented in [Type Checking and Type Inference](TypesAndTerms.lean.md#type-checking-and-type-inference)
must be generalized to work with dependent types:

\\( \cfrac{C ⊢ t : (x : σ) → τ[x] \quad C ⊢ u : σ }{C ⊢ t\enspace{u} : τ[u]} {\large A}{\normalsize PP'} \\)

\\( \cfrac{C, x : σ ⊢ t : τ[x] }{C ⊢ (λ\enspace{x} : σ => t) : (x : σ) → τ[x]} {\large L}{\normalsize AM'} \\)

The notation `τ[x]` stands for a type that may contain `x`, and `τ[u]` stands for the
same type where all occurrences of `x` have been replaced by `u`.

The simply typed case arises when `x` does not occur in `τ[x]`. Then, we can
simply write `σ →` instead of `(x : σ) →`. The familiar notation `σ → τ` is equivalent
to `(_ : σ) → τ`. It is easy to check that APP' and LAM' coincide with APP and LAM
when `x` does not occur in `τ[x]`. The example below demonstrates APP':

\\( \cfrac{pick : (n : ℕ) → i : ℕ // i ≤ n \quad 5 : ℕ }{⊢ pick\enspace{5} : i : ℕ // i ≤ 5} {\large A}{\normalsize PP'} \\)

The next example demonstrates LAM':

\\( \cfrac{\cfrac {α : Type, x : α ⊢ x : α} {α : Type ⊢ (λ\enspace{x} : α => x) : α → α}  {\large L}{\normalsize AM}\enspace{or}\enspace{\large L}{\normalsize AM'}} {⊢ (λ\enspace{α} : Type => λ\enspace{x} : α => x) : (α : Type) → α → α} {\large L}{\normalsize AM'} \\)

The picture is incomplete because we only check that the terms—the entities on the left-hand side of a
colon (:)—are well typed. The types—the entities on the right-hand side of a colon—must also be
checked, using the same type system, but this time as terms. For example, the type of `Nat.succ` is
`ℕ → ℕ`, whose type is `Type`. Types of types, such as `Type` and `Prop`, are called universes. We will study
them more closely in Chapter 11.

Regrettably, the intuitive syntax `(x : σ) → τ` used above is not available in Lean. Instead, we
must write `∀x : σ, τ`. The familiar notation `σ → τ` is supported as syntactic sugar for `∀ _ : σ, τ`. The
∀ syntax emphasizes that `x` is a bound variable. As an alias for ∀, we can also write Π. The two
symbols are interchangeable.

In [Type Definitions](../Basics/TypeDefinitions.lean.md), we saw the commands:
-/
#check List.nil
#check List.cons
/-!
and their output
```
[] : List ?m.26
List.cons : ?m.28 → List ?m.28 → List ?m.28
```
We can now make sense of the Π-type: `List.nil` is a function that takes a type `α`
as argument and that returns a value of type `List α`.

-- BUGBUG : lean4 no longer shows `List.nil : Π(α : Type), list α` - is there a better example
we can use here instead?
-/


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.finsupp
import data.finset.locally_finite
import data.finsupp.order

/-!
# Finite intervals of finitely supported functions

This file provides the `locally_finite_order` instance for `ι →₀ α` when `α` itself is locally
finite and calculates the cardinality of its finite intervals.

## Main declarations

* `finsupp.range_singleton`: Postcomposition with `has_singleton.singleton` on `finset` as a
  `finsupp`.
* `finsupp.range_Icc`: Postcomposition with `finset.Icc` as a `finsupp`.

Both these definitions use the fact that `0 = {0}` to ensure that the resulting function is finitely
supported.
-/

noncomputable theory

open finset finsupp function
open_locale big_operators classical pointwise

variables {ι α : Type*}

namespace finsupp
section range_singleton
variables [has_zero α] {f : ι →₀ α} {i : ι} {a : α}

/-- Pointwise `finset.singleton` bundled as a `finsupp`. -/
@[simps] def range_singleton (f : ι →₀ α) : ι →₀ finset α :=
{ to_fun := λ i, {f i},
  support := f.support,
  mem_support_to_fun := λ i, begin
    rw [←not_iff_not, not_mem_support_iff, not_ne_iff],
    exact singleton_injective.eq_iff.symm,
  end }

lemma mem_range_singleton_apply_iff : a ∈ f.range_singleton i ↔ a = f i := mem_singleton

end range_singleton

section range_Icc
variables [has_zero α] [partial_order α] [locally_finite_order α] {f g : ι →₀ α} {i : ι} {a : α}

/-- Pointwise `finset.Icc` bundled as a `finsupp`. -/
@[simps] def range_Icc (f g : ι →₀ α) : ι →₀ finset α :=
{ to_fun := λ i, Icc (f i) (g i),
  support := f.support ∪ g.support,
  mem_support_to_fun := λ i, begin
    rw [mem_union, ←not_iff_not, not_or_distrib, not_mem_support_iff, not_mem_support_iff,
      not_ne_iff],
    exact Icc_eq_singleton_iff.symm,
  end }

lemma mem_range_Icc_apply_iff : a ∈ f.range_Icc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc

end range_Icc

variables [partial_order α] [has_zero α] [locally_finite_order α] (f g : ι →₀ α)

instance : locally_finite_order (ι →₀ α) :=
locally_finite_order.of_Icc (ι →₀ α)
  (λ f g, (f.support ∪ g.support).finsupp $ f.range_Icc g)
  (λ f g x, begin
    refine (mem_finsupp_iff_of_support_subset $ subset.rfl).trans _,
    simp_rw mem_range_Icc_apply_iff,
    exact forall_and_distrib,
  end)

lemma card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card :=
card_finsupp _ _

lemma 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]

lemma 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]

lemma 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]

end finsupp


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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.binary_products
! leanprover-community/mathlib commit 024a4231815538ac739f52d08dd20a55da0d6b23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.BinaryProducts
import Mathlib.CategoryTheory.Limits.Preserves.Basic

/-!
# Preserving binary products

Constructions to relate the notions of preserving binary products and reflecting binary products
to concrete binary fans.

In particular, we show that `ProdComparison G X Y` is an isomorphism iff `G` preserves
the product of `X` and `Y`.
-/

noncomputable section

universe v₁ v₂ u₁ u₂

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

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

variable {D : Type u₂} [Category.{v₂} D]

variable (G : C ⥤ D)

namespace CategoryTheory.Limits

section

variable {P X Y Z : C} (f : P ⟶ X) (g : P ⟶ Y)

/--
The map of a binary fan is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `BinaryFan.mk` with `Functor.mapCone`.
-/
def isLimitMapConeBinaryFanEquiv :
    IsLimit (G.mapCone (BinaryFan.mk f g)) ≃ IsLimit (BinaryFan.mk (G.map f) (G.map g)) :=
  (IsLimit.postcomposeHomEquiv (diagramIsoPair _) _).symm.trans
    (IsLimit.equivIsoLimit
      (Cones.ext (Iso.refl _)
        (by rintro (_ | _) <;> simp)))
#align category_theory.limits.is_limit_map_cone_binary_fan_equiv CategoryTheory.Limits.isLimitMapConeBinaryFanEquiv

/-- The property of preserving products expressed in terms of binary fans. -/
def mapIsLimitOfPreservesOfIsLimit [PreservesLimit (pair X Y) G] (l : IsLimit (BinaryFan.mk f g)) :
    IsLimit (BinaryFan.mk (G.map f) (G.map g)) :=
  isLimitMapConeBinaryFanEquiv G f g (PreservesLimit.preserves l)
#align category_theory.limits.map_is_limit_of_preserves_of_is_limit CategoryTheory.Limits.mapIsLimitOfPreservesOfIsLimit

/-- The property of reflecting products expressed in terms of binary fans. -/
def isLimitOfReflectsOfMapIsLimit [ReflectsLimit (pair X Y) G]
    (l : IsLimit (BinaryFan.mk (G.map f) (G.map g))) : IsLimit (BinaryFan.mk f g) :=
  ReflectsLimit.reflects ((isLimitMapConeBinaryFanEquiv G f g).symm l)
#align category_theory.limits.is_limit_of_reflects_of_map_is_limit CategoryTheory.Limits.isLimitOfReflectsOfMapIsLimit

variable (X Y) [HasBinaryProduct X Y]

/-- If `G` preserves binary products and `C` has them, then the binary fan constructed of the mapped
morphisms of the binary product cone is a limit.
-/
def isLimitOfHasBinaryProductOfPreservesLimit [PreservesLimit (pair X Y) G] :
    IsLimit (BinaryFan.mk (G.map (Limits.prod.fst : X ⨯ Y ⟶ X)) (G.map Limits.prod.snd)) :=
  mapIsLimitOfPreservesOfIsLimit G _ _ (prodIsProd X Y)
#align category_theory.limits.is_limit_of_has_binary_product_of_preserves_limit CategoryTheory.Limits.isLimitOfHasBinaryProductOfPreservesLimit

variable [HasBinaryProduct (G.obj X) (G.obj Y)]

/-- If the product comparison map for `G` at `(X,Y)` is an isomorphism, then `G` preserves the
pair of `(X,Y)`.
-/
def PreservesLimitPair.ofIsoProdComparison [i : IsIso (prodComparison G X Y)] :
    PreservesLimit (pair X Y) G := by
  apply preservesLimitOfPreservesLimitCone (prodIsProd X Y)
  apply (isLimitMapConeBinaryFanEquiv _ _ _).symm _
  refine @IsLimit.ofPointIso _ _ _ _ _ _ _ (limit.isLimit (pair (G.obj X) (G.obj Y))) ?_
  apply i
#align category_theory.limits.preserves_limit_pair.of_iso_prod_comparison CategoryTheory.Limits.PreservesLimitPair.ofIsoProdComparison

variable [PreservesLimit (pair X Y) G]

/-- If `G` preserves the product of `(X,Y)`, then the product comparison map for `G` at `(X,Y)` is
an isomorphism.
-/
def PreservesLimitPair.iso : G.obj (X ⨯ Y) ≅ G.obj X ⨯ G.obj Y :=
  IsLimit.conePointUniqueUpToIso (isLimitOfHasBinaryProductOfPreservesLimit G X Y) (limit.isLimit _)
#align category_theory.limits.preserves_limit_pair.iso CategoryTheory.Limits.PreservesLimitPair.iso

@[simp]
theorem PreservesLimitPair.iso_hom : (PreservesLimitPair.iso G X Y).hom = prodComparison G X Y :=
  rfl
#align category_theory.limits.preserves_limit_pair.iso_hom CategoryTheory.Limits.PreservesLimitPair.iso_hom

instance : IsIso (prodComparison G X Y) := by
  rw [← PreservesLimitPair.iso_hom]
  infer_instance

end

section

variable {P X Y Z : C} (f : X ⟶ P) (g : Y ⟶ P)

/-- The map of a binary cofan is a colimit iff
the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `BinaryCofan.mk` with `Functor.mapCocone`.
-/
def isColimitMapCoconeBinaryCofanEquiv :
    IsColimit (Functor.mapCocone G (BinaryCofan.mk f g))
    ≃ IsColimit (BinaryCofan.mk (G.map f) (G.map g)) :=
  (IsColimit.precomposeHomEquiv (diagramIsoPair _).symm _).symm.trans
    (IsColimit.equivIsoColimit
      (Cocones.ext (Iso.refl _)
        (by rintro (_ | _) <;> simp)))
#align category_theory.limits.is_colimit_map_cocone_binary_cofan_equiv CategoryTheory.Limits.isColimitMapCoconeBinaryCofanEquiv

/-- The property of preserving coproducts expressed in terms of binary cofans. -/
def mapIsColimitOfPreservesOfIsColimit [PreservesColimit (pair X Y) G]
    (l : IsColimit (BinaryCofan.mk f g)) : IsColimit (BinaryCofan.mk (G.map f) (G.map g)) :=
  isColimitMapCoconeBinaryCofanEquiv G f g (PreservesColimit.preserves l)
#align category_theory.limits.map_is_colimit_of_preserves_of_is_colimit CategoryTheory.Limits.mapIsColimitOfPreservesOfIsColimit

/-- The property of reflecting coproducts expressed in terms of binary cofans. -/
def isColimitOfReflectsOfMapIsColimit [ReflectsColimit (pair X Y) G]
    (l : IsColimit (BinaryCofan.mk (G.map f) (G.map g))) : IsColimit (BinaryCofan.mk f g) :=
  ReflectsColimit.reflects ((isColimitMapCoconeBinaryCofanEquiv G f g).symm l)
#align category_theory.limits.is_colimit_of_reflects_of_map_is_colimit CategoryTheory.Limits.isColimitOfReflectsOfMapIsColimit

variable (X Y) [HasBinaryCoproduct X Y]

/--
If `G` preserves binary coproducts and `C` has them, then the binary cofan constructed of the mapped
morphisms of the binary product cocone is a colimit.
-/
def isColimitOfHasBinaryCoproductOfPreservesColimit [PreservesColimit (pair X Y) G] :
    IsColimit (BinaryCofan.mk (G.map (Limits.coprod.inl : X ⟶ X ⨿ Y)) (G.map Limits.coprod.inr)) :=
  mapIsColimitOfPreservesOfIsColimit G _ _ (coprodIsCoprod X Y)
#align category_theory.limits.is_colimit_of_has_binary_coproduct_of_preserves_colimit CategoryTheory.Limits.isColimitOfHasBinaryCoproductOfPreservesColimit

variable [HasBinaryCoproduct (G.obj X) (G.obj Y)]

/-- If the coproduct comparison map for `G` at `(X,Y)` is an isomorphism, then `G` preserves the
pair of `(X,Y)`.
-/
def PreservesColimitPair.ofIsoCoprodComparison [i : IsIso (coprodComparison G X Y)] :
    PreservesColimit (pair X Y) G := by
  apply preservesColimitOfPreservesColimitCocone (coprodIsCoprod X Y)
  apply (isColimitMapCoconeBinaryCofanEquiv _ _ _).symm _
  refine @IsColimit.ofPointIso _ _ _ _ _ _ _ (colimit.isColimit (pair (G.obj X) (G.obj Y))) ?_
  apply i
#align category_theory.limits.preserves_colimit_pair.of_iso_coprod_comparison CategoryTheory.Limits.PreservesColimitPair.ofIsoCoprodComparison

variable [PreservesColimit (pair X Y) G]

/--
If `G` preserves the coproduct of `(X,Y)`, then the coproduct comparison map for `G` at `(X,Y)` is
an isomorphism.
-/
def PreservesColimitPair.iso : G.obj X ⨿ G.obj Y ≅ G.obj (X ⨿ Y) :=
  IsColimit.coconePointUniqueUpToIso (colimit.isColimit _)
    (isColimitOfHasBinaryCoproductOfPreservesColimit G X Y)
#align category_theory.limits.preserves_colimit_pair.iso CategoryTheory.Limits.PreservesColimitPair.iso

@[simp]
theorem PreservesColimitPair.iso_hom :
    (PreservesColimitPair.iso G X Y).hom = coprodComparison G X Y := rfl
#align category_theory.limits.preserves_colimit_pair.iso_hom CategoryTheory.Limits.PreservesColimitPair.iso_hom

instance : IsIso (coprodComparison G X Y) := by
  rw [← PreservesColimitPair.iso_hom]
  infer_instance

end

end CategoryTheory.Limits