import simple_graph

noncomputable theory
open_locale classical

universes u
variables {V : Type u}
namespace simple_graph

def is_subgraph (H : simple_graph V) (G : simple_graph V)  : Prop :=
∀ u v, H.adj u v → G.adj u v

variables (G : simple_graph V)
include G

@[refl] lemma is_subgraph_self : G.is_subgraph G := by tidy

lemma empty_is_subgraph : empty.is_subgraph G := by tidy

variables [fintype V]

  -- want a lemma that 2 * card_edges equals the card of a specific finset.
-- lemma 2 * G.card_edges = finset.card G.E_finset

@[elab_as_eliminator]
lemma induction_on
  (P : simple_graph V → Prop)
  (P_empty : P empty)
  (P_inductive : ∀ G ≠ empty, ∃ (H : simple_graph V),
    H.is_subgraph G ∧
    H.card_edges < G.card_edges ∧
    (P H → P G) ) : P G :=
begin
  by_cases h : G = empty, { rwa h },
  suffices : ∀ H : simple_graph V, H.card_edges < G.card_edges → P H,
  { have := P_inductive G h, tauto },
  induction G.card_edges using nat.strong_induction_on with k hk,
  intros H hHk,
  by_cases H_card : H = empty, { cc },
  rcases P_inductive H H_card with ⟨K, K_sub, K_card, hKH⟩,
  apply hKH, exact hk _ hHk _ K_card,
end
-- for every graph, there exists an edge so that P (G.erase e) → P G

def erase (e : G.E) : simple_graph V :=
{ adj := λ u v, if u ∈ e ∧ v ∈ e then false else G.adj u v,
  sym := by { unfold symmetric, intros, simp_rw [edge_symm, and_comm], cc } }

@[simp] lemma erase_adj_iff (e : G.E) (u v : V) :
  (G.erase e).adj u v ↔ G.adj u v ∧ (u ∉ e ∨ v ∉ e) :=
by { simp [erase]; tauto, }

lemma erase_is_subgraph (e : G.E) : (G.erase e).is_subgraph G := by tidy
-- writing this down in a way that avoids nat subtraction
lemma card_edges_erase (e : G.E) : (G.erase e).card_edges + 1 = G.card_edges :=
begin
  sorry
end
@[elab_as_eliminator]
lemma induction_on_erase
  (P : simple_graph V → Prop)
  (P_empty : P empty)
  (P_inductive : ∀ G : simple_graph V, G ≠ empty →
    ∃ e : G.E, P (G.erase e) → P G)
  : P G :=
begin
  apply G.induction_on, assumption,
  intros G₁ hG₁, cases P_inductive G₁ hG₁ with e he,
  use G₁.erase e,
  split, { apply erase_is_subgraph },
  split, linarith [G₁.card_edges_erase e],
  assumption,
end

end simple_graph


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Devon Tuma
-/
import analysis.asymptotics.asymptotic_equivalent
import analysis.asymptotics.specific_asymptotics
import data.polynomial.ring_division

/-!
# Limits related to polynomial and rational functions

This file proves basic facts about limits of polynomial and rationals functions.
The main result is `eval_is_equivalent_at_top_eval_lead`, which states that for
any polynomial `P` of degree `n` with leading coefficient `a`, the corresponding
polynomial function is equivalent to `a * x^n` as `x` goes to +∞.

We can then use this result to prove various limits for polynomial and rational
functions, depending on the degrees and leading coefficients of the considered
polynomials.
-/

open filter finset asymptotics
open_locale asymptotics polynomial topological_space

namespace polynomial

variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜] (P Q : 𝕜[X])

lemma eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in at_top, ¬ P.is_root x :=
at_top_le_cofinite $ (finite_set_of_is_root hP).compl_mem_cofinite

variables [order_topology 𝕜]

section polynomial_at_top

lemma is_equivalent_at_top_lead :
  (λ x, eval x P) ~[at_top] (λ x, P.leading_coeff * x ^ P.nat_degree) :=
begin
  by_cases h : P = 0,
  { simp [h] },
  { conv_rhs
    { funext,
      rw [polynomial.eval_eq_sum_range, sum_range_succ] },
    exact is_equivalent.refl.add_is_o (is_o.sum $ λ i hi, is_o.const_mul_left
      (is_o.const_mul_right (λ hz, h $ leading_coeff_eq_zero.mp hz) $
        is_o_pow_pow_at_top_of_lt (mem_range.mp hi)) _) }
end

lemma tendsto_at_top_of_leading_coeff_nonneg (hdeg : 1 ≤ P.degree) (hnng : 0 ≤ P.leading_coeff) :
  tendsto (λ x, eval x P) at_top at_top :=
P.is_equivalent_at_top_lead.symm.tendsto_at_top
  (tendsto_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnng $ ne.symm $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_top_iff_leading_coeff_nonneg :
  tendsto (λ x, eval x P) at_top at_top ↔ 1 ≤ P.degree ∧ 0 ≤ P.leading_coeff :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_top_of_leading_coeff_nonneg P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_top :=
    is_equivalent.tendsto_at_top (is_equivalent_at_top_lead P) h,
  rw tendsto_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2).symm), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma tendsto_at_bot_of_leading_coeff_nonpos (hdeg : 1 ≤ P.degree) (hnps : P.leading_coeff ≤ 0) :
  tendsto (λ x, eval x P) at_top at_bot :=
P.is_equivalent_at_top_lead.symm.tendsto_at_bot
  (tendsto_neg_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnps $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_bot_iff_leading_coeff_nonpos :
  tendsto (λ x, eval x P) at_top at_bot ↔ 1 ≤ P.degree ∧ P.leading_coeff ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_bot_of_leading_coeff_nonpos P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_bot :=
    (is_equivalent.tendsto_at_bot (is_equivalent_at_top_lead P) h),
  rw tendsto_neg_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2)), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma abs_tendsto_at_top (hdeg : 1 ≤ P.degree) :
  tendsto (λ x, abs $ eval x P) at_top at_top :=
begin
  by_cases hP : 0 ≤ P.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP)},
  { push_neg at hP,
    exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP.le)}
end

lemma abs_is_bounded_under_iff :
  is_bounded_under (≤) at_top (λ x, |eval x P|) ↔ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, ⟨|P.coeff 0|, eventually_map.mpr (eventually_of_forall
    (forall_imp (λ _, le_of_eq) (λ x, congr_arg abs $ trans (congr_arg (eval x)
    (eq_C_of_degree_le_zero h)) (eval_C))))⟩⟩,
  contrapose! h,
  exact not_is_bounded_under_of_tendsto_at_top
    (abs_tendsto_at_top P (nat.with_bot.one_le_iff_zero_lt.2 h))
end

lemma abs_tendsto_at_top_iff :
  tendsto (λ x, abs $ eval x P) at_top at_top ↔ 1 ≤ P.degree :=
⟨λ h, nat.with_bot.one_le_iff_zero_lt.2 (not_le.mp ((mt (abs_is_bounded_under_iff P).mpr)
  (not_is_bounded_under_of_tendsto_at_top h))), abs_tendsto_at_top P⟩

lemma tendsto_nhds_iff {c : 𝕜} :
  tendsto (λ x, eval x P) at_top (𝓝 c) ↔ P.leading_coeff = c ∧ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have := P.is_equivalent_at_top_lead.tendsto_nhds h,
    by_cases hP : P.leading_coeff = 0,
    { simp only [hP, zero_mul, tendsto_const_nhds_iff] at this,
      refine ⟨trans hP this, by simp [leading_coeff_eq_zero.1 hP]⟩ },
    { rw [tendsto_const_mul_pow_nhds_iff hP, nat_degree_eq_zero_iff_degree_le_zero] at this,
      exact this.symm } },
  { refine P.is_equivalent_at_top_lead.symm.tendsto_nhds _,
    have : P.nat_degree = 0 := nat_degree_eq_zero_iff_degree_le_zero.2 h.2,
    simp only [h.1, this, pow_zero, mul_one],
    exact tendsto_const_nhds }
end

end polynomial_at_top

section polynomial_div_at_top

lemma is_equivalent_at_top_div :
  (λ x, (eval x P)/(eval x Q)) ~[at_top]
    λ x, P.leading_coeff/Q.leading_coeff * x^(P.nat_degree - Q.nat_degree : ℤ) :=
begin
  by_cases hP : P = 0,
  { simp [hP] },
  by_cases hQ : Q = 0,
  { simp [hQ] },
  refine (P.is_equivalent_at_top_lead.symm.div
          Q.is_equivalent_at_top_lead.symm).symm.trans
         (eventually_eq.is_equivalent ((eventually_gt_at_top 0).mono $ λ x hx, _)),
  simp [← div_mul_div_comm, hP, hQ, zpow_sub₀ hx.ne.symm]
end

lemma div_tendsto_zero_of_degree_lt (hdeg : P.degree < Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) :=
begin
  by_cases hP : P = 0,
  { simp [hP, tendsto_const_nhds] },
  rw ←  nat_degree_lt_nat_degree_iff hP at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw ← mul_zero,
  refine (tendsto_zpow_at_top_zero _).const_mul _,
  linarith
end

lemma div_tendsto_zero_iff_degree_lt (hQ : Q ≠ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) ↔ P.degree < Q.degree :=
begin
  refine ⟨λ h, _, div_tendsto_zero_of_degree_lt P Q⟩,
  by_cases hPQ : P.leading_coeff / Q.leading_coeff = 0,
  { simp only [div_eq_mul_inv, inv_eq_zero, mul_eq_zero] at hPQ,
    cases hPQ with hP0 hQ0,
    { rw [leading_coeff_eq_zero.1 hP0, degree_zero],
      exact bot_lt_iff_ne_bot.2 (λ hQ', hQ (degree_eq_bot.1 hQ')) },
    { exact absurd (leading_coeff_eq_zero.1 hQ0) hQ } },
  { have := (is_equivalent_at_top_div P Q).tendsto_nhds h,
    rw tendsto_const_mul_zpow_at_top_zero_iff hPQ at this,
    cases this with h h,
    { exact absurd h.2 hPQ },
    { rw [sub_lt_iff_lt_add, zero_add, int.coe_nat_lt] at h,
      exact degree_lt_degree h.1 } }
end

lemma div_tendsto_leading_coeff_div_of_degree_eq (hdeg : P.degree = Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 $ P.leading_coeff / Q.leading_coeff) :=
begin
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw show (P.nat_degree : ℤ) = Q.nat_degree, by simp [hdeg, nat_degree],
  simp [tendsto_const_nhds]
end

lemma div_tendsto_at_top_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hpos : 0 < P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hpos, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_top _,
  apply tendsto.const_mul_at_top hpos,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnng : 0 ≤ P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
have ratio_pos : 0 < P.leading_coeff/Q.leading_coeff,
  from lt_of_le_of_ne hnng
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)).symm,
div_tendsto_at_top_of_degree_gt' P Q hdeg ratio_pos

lemma div_tendsto_at_bot_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hneg : P.leading_coeff/Q.leading_coeff < 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hneg, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_bot _,
  apply tendsto.neg_const_mul_at_top hneg,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_bot_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnps : P.leading_coeff/Q.leading_coeff ≤ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
have ratio_neg : P.leading_coeff/Q.leading_coeff < 0,
  from lt_of_le_of_ne hnps
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)),
div_tendsto_at_bot_of_degree_gt' P Q hdeg ratio_neg

lemma abs_div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) :
  tendsto (λ x, |(eval x P)/(eval x Q)|) at_top at_top :=
begin
  by_cases h : 0 ≤ P.leading_coeff/Q.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.div_tendsto_at_top_of_degree_gt Q hdeg hQ h) },
  { push_neg at h,
    exact tendsto_abs_at_bot_at_top.comp (P.div_tendsto_at_bot_of_degree_gt Q hdeg hQ h.le) }
end

end polynomial_div_at_top

theorem is_O_of_degree_le (h : P.degree ≤ Q.degree) :
  (λ x, eval x P) =O[at_top] (λ x, eval x Q) :=
begin
  by_cases hp : P = 0,
  { simpa [hp] using is_O_zero (λ x, eval x Q) at_top },
  { have hq : Q ≠ 0 := ne_zero_of_degree_ge_degree h hp,
    have hPQ : ∀ᶠ (x : 𝕜) in at_top, eval x Q = 0 → eval x P = 0 :=
      filter.mem_of_superset (polynomial.eventually_no_roots Q hq) (λ x h h', absurd h' h),
    cases le_iff_lt_or_eq.mp h with h h,
    { exact is_O_of_div_tendsto_nhds hPQ 0 (div_tendsto_zero_of_degree_lt P Q h) },
    { exact is_O_of_div_tendsto_nhds hPQ _ (div_tendsto_leading_coeff_div_of_degree_eq P Q h) } }
end

end polynomial


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.continuous_function.bounded
import topology.uniform_space.compact_separated

/-!
# Continuous functions on a compact space

Continuous functions `C(α, β)` from a compact space `α` to a metric space `β`
are automatically bounded, and so acquire various structures inherited from `α →ᵇ β`.

This file transfers these structures, and restates some lemmas
characterising these structures.

If you need a lemma which is proved about `α →ᵇ β` but not for `C(α, β)` when `α` is compact,
you should restate it here. You can also use
`bounded_continuous_function.equiv_continuous_map_of_compact` to move functions back and forth.

-/

noncomputable theory
open_locale topological_space classical nnreal bounded_continuous_function

open set filter metric

open bounded_continuous_function

namespace continuous_map

variables {α β E : Type*} [topological_space α] [compact_space α] [metric_space β] [normed_group E]

section

variables (α β)

/--
When `α` is compact, the bounded continuous maps `α →ᵇ β` are
equivalent to `C(α, β)`.
-/
@[simps { fully_applied := ff }]
def equiv_bounded_of_compact : C(α, β) ≃ (α →ᵇ β) :=
⟨mk_of_compact, to_continuous_map, λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

lemma uniform_inducing_equiv_bounded_of_compact :
  uniform_inducing (equiv_bounded_of_compact α β) :=
uniform_inducing.mk'
begin
  simp only [has_basis_compact_convergence_uniformity.mem_iff, uniformity_basis_dist_le.mem_iff],
  exact λ s, ⟨λ ⟨⟨a, b⟩, ⟨ha, ⟨ε, hε, hb⟩⟩, hs⟩, ⟨{p | ∀ x, (p.1 x, p.2 x) ∈ b},
    ⟨ε, hε, λ _ h x, hb (by exact (dist_le hε.le).mp h x)⟩, λ f g h, hs (by exact λ x hx, h x)⟩,
    λ ⟨t, ⟨ε, hε, ht⟩, hs⟩, ⟨⟨set.univ, {p | dist p.1 p.2 ≤ ε}⟩, ⟨compact_univ, ⟨ε, hε, λ _ h, h⟩⟩,
    λ ⟨f, g⟩ h, hs _ _ (ht (by exact (dist_le hε.le).mpr (λ x, h x (mem_univ x))))⟩⟩,
end

lemma uniform_embedding_equiv_bounded_of_compact :
  uniform_embedding (equiv_bounded_of_compact α β) :=
{ inj := (equiv_bounded_of_compact α β).injective,
  .. uniform_inducing_equiv_bounded_of_compact α β }

/--
When `α` is compact, the bounded continuous maps `α →ᵇ 𝕜` are
additively equivalent to `C(α, 𝕜)`.
-/
@[simps apply symm_apply { fully_applied := ff }]
def add_equiv_bounded_of_compact [add_monoid β] [has_lipschitz_add β] :
  C(α, β) ≃+ (α →ᵇ β) :=
({ .. to_continuous_map_add_hom α β,
   .. (equiv_bounded_of_compact α β).symm, } : (α →ᵇ β) ≃+ C(α, β)).symm

instance : metric_space C(α, β) :=
(uniform_embedding_equiv_bounded_of_compact α β).comap_metric_space _

/--
When `α` is compact, and `β` is a metric space, the bounded continuous maps `α →ᵇ β` are
isometric to `C(α, β)`.
-/
@[simps to_equiv apply symm_apply { fully_applied := ff }]
def isometric_bounded_of_compact :
  C(α, β) ≃ᵢ (α →ᵇ β) :=
{ isometry_to_fun := λ x y, rfl,
  to_equiv := equiv_bounded_of_compact α β }

end

@[simp] lemma _root_.bounded_continuous_function.dist_mk_of_compact (f g : C(α, β)) :
  dist (mk_of_compact f) (mk_of_compact g) = dist f g := rfl

@[simp] lemma _root_.bounded_continuous_function.dist_to_continuous_map (f g : α →ᵇ β) :
  dist (f.to_continuous_map) (g.to_continuous_map) = dist f g := rfl

open bounded_continuous_function

section
variables {α β} {f g : C(α, β)} {C : ℝ}

/-- The pointwise distance is controlled by the distance between functions, by definition. -/
lemma dist_apply_le_dist (x : α) : dist (f x) (g x) ≤ dist f g :=
by simp only [← dist_mk_of_compact, dist_coe_le_dist, ← mk_of_compact_apply]

/-- The distance between two functions is controlled by the supremum of the pointwise distances -/
lemma dist_le (C0 : (0 : ℝ) ≤ C) : dist f g ≤ C ↔ ∀x:α, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le C0, mk_of_compact_apply]

lemma dist_le_iff_of_nonempty [nonempty α] :
  dist f g ≤ C ↔ ∀ x, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le_iff_of_nonempty, mk_of_compact_apply]

lemma dist_lt_iff_of_nonempty [nonempty α] :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_nonempty_compact, mk_of_compact_apply]

lemma dist_lt_of_nonempty [nonempty α] (w : ∀x:α, dist (f x) (g x) < C) : dist f g < C :=
(dist_lt_iff_of_nonempty).2 w

lemma dist_lt_iff (C0 : (0 : ℝ) < C) :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_compact C0, mk_of_compact_apply]

end

instance [complete_space β] : complete_space (C(α, β)) :=
(isometric_bounded_of_compact α β).complete_space

@[continuity] lemma continuous_eval : continuous (λ p : C(α, β) × α, p.1 p.2) :=
continuous_eval.comp ((isometric_bounded_of_compact α β).continuous.prod_map continuous_id)

@[continuity] lemma continuous_evalx (x : α) : continuous (λ f : C(α, β), f x) :=
continuous_eval.comp (continuous_id.prod_mk continuous_const)

lemma continuous_coe : @continuous (C(α, β)) (α → β) _ _ coe_fn :=
continuous_pi continuous_evalx

-- TODO at some point we will need lemmas characterising this norm!
-- At the moment the only way to reason about it is to transfer `f : C(α,E)` back to `α →ᵇ E`.
instance : has_norm C(α, E) :=
{ norm := λ x, dist x 0 }

@[simp] lemma _root_.bounded_continuous_function.norm_mk_of_compact (f : C(α, E)) :
  ∥mk_of_compact f∥ = ∥f∥ := rfl

@[simp] lemma _root_.bounded_continuous_function.norm_to_continuous_map_eq (f : α →ᵇ E) :
  ∥f.to_continuous_map∥ = ∥f∥ :=
rfl

open bounded_continuous_function

instance : normed_group C(α, E) :=
{ dist_eq := λ x y,
  begin
    rw [← norm_mk_of_compact, ← dist_mk_of_compact, dist_eq_norm],
    congr' 1,
    exact ((add_equiv_bounded_of_compact α E).map_sub _ _).symm
  end, }

section
variables (f : C(α, E))
-- The corresponding lemmas for `bounded_continuous_function` are stated with `{f}`,
-- and so can not be used in dot notation.

lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ :=
(mk_of_compact f).norm_coe_le_norm x

/-- Distance between the images of any two points is at most twice the norm of the function. -/
lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ∥f∥ :=
(mk_of_compact f).dist_le_two_norm x y

/-- The norm of a function is controlled by the supremum of the pointwise norms -/
lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
@bounded_continuous_function.norm_le _ _ _ _
  (mk_of_compact f) _ C0

lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
@bounded_continuous_function.norm_le_of_nonempty _ _ _ _ _ (mk_of_compact f) _

lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_compact _ _ _ _ _ (mk_of_compact f) _ M0

lemma norm_lt_iff_of_nonempty [nonempty α] {M : ℝ} :
  ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
@bounded_continuous_function.norm_lt_iff_of_nonempty_compact _ _ _ _ _ _ (mk_of_compact f) _

lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ∥f∥ :=
le_trans (le_abs.mpr (or.inl (le_refl (f x)))) (f.norm_coe_le_norm x)

lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -∥f∥ ≤ f x :=
le_trans (neg_le_neg (f.norm_coe_le_norm x)) (neg_le.mp (neg_le_abs_self (f x)))

lemma norm_eq_supr_norm : ∥f∥ = ⨆ x : α, ∥f x∥ :=
(mk_of_compact f).norm_eq_supr_norm

end

section
variables {R : Type*} [normed_ring R]

instance : normed_ring C(α,R) :=
{ norm_mul := λ f g, norm_mul_le (mk_of_compact f) (mk_of_compact g),
  ..(infer_instance : normed_group C(α,R)) }

end

section
variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]

instance : normed_space 𝕜 C(α,E) :=
{ norm_smul_le := λ c f, le_of_eq (norm_smul c (mk_of_compact f)) }

section
variables (α 𝕜 E)

/--
When `α` is compact and `𝕜` is a normed field,
the `𝕜`-algebra of bounded continuous maps `α →ᵇ β` is
`𝕜`-linearly isometric to `C(α, β)`.
-/
def linear_isometry_bounded_of_compact :
  C(α, E) ≃ₗᵢ[𝕜] (α →ᵇ E) :=
{ map_smul' := λ c f, by { ext, simp, },
  norm_map' := λ f, rfl,
  .. add_equiv_bounded_of_compact α E }

end

-- this lemma and the next are the analogues of those autogenerated by `@[simps]` for
-- `equiv_bounded_of_compact`, `add_equiv_bounded_of_compact`
@[simp] lemma linear_isometry_bounded_of_compact_symm_apply (f : α →ᵇ E) :
  (linear_isometry_bounded_of_compact α E 𝕜).symm f = f.to_continuous_map :=
rfl

@[simp] lemma linear_isometry_bounded_of_compact_apply_apply (f : C(α, E)) (a : α) :
  (linear_isometry_bounded_of_compact α E 𝕜 f) a = f a :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_isometric :
  (linear_isometry_bounded_of_compact α E 𝕜).to_isometric = (isometric_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_add_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_add_equiv =
    (add_equiv_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_of_compact_to_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_equiv =
    (equiv_bounded_of_compact α E) :=
rfl

end

section
variables {𝕜 : Type*} {γ : Type*} [normed_field 𝕜] [normed_ring γ] [normed_algebra 𝕜 γ]

instance [nonempty α] : normed_algebra 𝕜 C(α, γ) :=
{ norm_algebra_map_eq := λ c, (norm_algebra_map_eq (α →ᵇ γ) c : _), }

end

end continuous_map

namespace continuous_map

section uniform_continuity
variables {α β : Type*}
variables [metric_space α] [compact_space α] [metric_space β]

/-!
We now set up some declarations making it convenient to use uniform continuity.
-/

lemma uniform_continuity
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) :
  ∃ δ > 0, ∀ {x y}, dist x y < δ → dist (f x) (f y) < ε :=
metric.uniform_continuous_iff.mp
  (compact_space.uniform_continuous_of_continuous f.continuous) ε h

/--
An arbitrarily chosen modulus of uniform continuity for a given function `f` and `ε > 0`.
-/
-- This definition allows us to separate the choice of some `δ`,
-- and the corresponding use of `dist a b < δ → dist (f a) (f b) < ε`,
-- even across different declarations.
def modulus (f : C(α, β)) (ε : ℝ) (h : 0 < ε) : ℝ :=
classical.some (uniform_continuity f ε h)

lemma modulus_pos (f : C(α, β)) {ε : ℝ} {h : 0 < ε} : 0 < f.modulus ε h :=
(classical.some_spec (uniform_continuity f ε h)).fst

lemma dist_lt_of_dist_lt_modulus
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) {a b : α} (w : dist a b < f.modulus ε h) :
  dist (f a) (f b) < ε :=
(classical.some_spec (uniform_continuity f ε h)).snd w

end uniform_continuity

end continuous_map

section comp_left
variables (X : Type*) {𝕜 β γ : Type*} [topological_space X] [compact_space X]
  [nondiscrete_normed_field 𝕜]
variables [normed_group β] [normed_space 𝕜 β] [normed_group γ] [normed_space 𝕜 γ]

open continuous_map

/--
Postcomposition of continuous functions into a normed module by a continuous linear map is a
continuous linear map.
Transferred version of `continuous_linear_map.comp_left_continuous_bounded`,
upgraded version of `continuous_linear_map.comp_left_continuous`,
similar to `linear_map.comp_left`. -/
protected def continuous_linear_map.comp_left_continuous_compact (g : β →L[𝕜] γ) :
  C(X, β) →L[𝕜] C(X, γ) :=
(linear_isometry_bounded_of_compact X γ 𝕜).symm.to_linear_isometry.to_continuous_linear_map.comp $
(g.comp_left_continuous_bounded X).comp $
(linear_isometry_bounded_of_compact X β 𝕜).to_linear_isometry.to_continuous_linear_map

@[simp] lemma continuous_linear_map.to_linear_comp_left_continuous_compact (g : β →L[𝕜] γ) :
  (g.comp_left_continuous_compact X : C(X, β) →ₗ[𝕜] C(X, γ)) = g.comp_left_continuous 𝕜 X :=
by { ext f, refl }

@[simp] lemma continuous_linear_map.comp_left_continuous_compact_apply (g : β →L[𝕜] γ)
  (f : C(X, β)) (x : X) :
  g.comp_left_continuous_compact X f x = g (f x) :=
rfl

end comp_left

namespace continuous_map
/-!
We now setup variations on `comp_right_* f`, where `f : C(X, Y)`
(that is, precomposition by a continuous map),
as a morphism `C(Y, T) → C(X, T)`, respecting various types of structure.

In particular:
* `comp_right_continuous_map`, the bundled continuous map (for this we need `X Y` compact).
* `comp_right_homeomorph`, when we precompose by a homeomorphism.
* `comp_right_alg_hom`, when `T = R` is a topological ring.
-/
section comp_right

/--
Precomposition by a continuous map is itself a continuous map between spaces of continuous maps.
-/
def comp_right_continuous_map {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) : C(C(Y, T), C(X, T)) :=
{ to_fun := λ g, g.comp f,
  continuous_to_fun :=
  begin
    refine metric.continuous_iff.mpr _,
    intros g ε ε_pos,
    refine ⟨ε, ε_pos, λ g' h, _⟩,
    rw continuous_map.dist_lt_iff ε_pos at h ⊢,
    { exact λ x, h (f x), },
  end }

@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : C(X, Y)) (g : C(Y, T)) :
  (comp_right_continuous_map T f) g = g.comp f :=
rfl

/--
Precomposition by a homeomorphism is itself a homeomorphism between spaces of continuous maps.
-/
def comp_right_homeomorph {X Y : Type*} (T : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
  (f : X ≃ₜ Y) : C(Y, T) ≃ₜ C(X, T) :=
{ to_fun := comp_right_continuous_map T f.to_continuous_map,
  inv_fun := comp_right_continuous_map T f.symm.to_continuous_map,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
Precomposition of functions into a normed ring by continuous map is an algebra homomorphism.
-/
def comp_right_alg_hom {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) :
  C(Y, R) →ₐ[R] C(X, R) :=
{ to_fun := λ g, g.comp f,
  map_zero' := by { ext, simp, },
  map_add' := λ g₁ g₂, by { ext, simp, },
  map_one' := by { ext, simp, },
  map_mul' := λ g₁ g₂, by { ext, simp, },
  commutes' := λ r, by { ext, simp, }, }

@[simp] lemma comp_right_alg_hom_apply {X Y : Type*} (R : Type*)
  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) (g : C(Y, R)) :
  (comp_right_alg_hom R f) g = g.comp f :=
rfl

lemma comp_right_alg_hom_continuous {X Y : Type*} (R : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y]
  [normed_comm_ring R] (f : C(X, Y)) :
  continuous (comp_right_alg_hom R f) :=
begin
  change continuous (comp_right_continuous_map R f),
  continuity,
end

end comp_right

end continuous_map


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

! This file was ported from Lean 3 source module topology.order.lattice
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Order.Basic
import Mathbin.Topology.Constructions

/-!
# Topological lattices

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

In this file we define mixin classes `has_continuous_inf` and `has_continuous_sup`. We define the
class `topological_lattice` as a topological space and lattice `L` extending `has_continuous_inf`
and `has_continuous_sup`.

## References

* [Gierz et al, A Compendium of Continuous Lattices][GierzEtAl1980]

## Tags

topological, lattice
-/

open Filter

open Topology

#print ContinuousInf /-
/-- Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be an infimum. Then `L` is said to have *(jointly) continuous infimum* if the map
`⊓:L×L → L` is continuous.
-/
class ContinuousInf (L : Type _) [TopologicalSpace L] [Inf L] : Prop where
  continuous_inf : Continuous fun p : L × L => p.1 ⊓ p.2
#align has_continuous_inf ContinuousInf
-/

#print ContinuousSup /-
/-- Let `L` be a topological space and let `L×L` be equipped with the product topology and let
`⊓:L×L → L` be a supremum. Then `L` is said to have *(jointly) continuous supremum* if the map
`⊓:L×L → L` is continuous.
-/
class ContinuousSup (L : Type _) [TopologicalSpace L] [Sup L] : Prop where
  continuous_sup : Continuous fun p : L × L => p.1 ⊔ p.2
#align has_continuous_sup ContinuousSup
-/

#print OrderDual.continuousSup /-
-- see Note [lower instance priority]
instance (priority := 100) OrderDual.continuousSup (L : Type _) [TopologicalSpace L] [Inf L]
    [ContinuousInf L] : ContinuousSup Lᵒᵈ
    where continuous_sup := @ContinuousInf.continuous_inf L _ _ _
#align order_dual.has_continuous_sup OrderDual.continuousSup
-/

#print OrderDual.continuousInf /-
-- see Note [lower instance priority]
instance (priority := 100) OrderDual.continuousInf (L : Type _) [TopologicalSpace L] [Sup L]
    [ContinuousSup L] : ContinuousInf Lᵒᵈ
    where continuous_inf := @ContinuousSup.continuous_sup L _ _ _
#align order_dual.has_continuous_inf OrderDual.continuousInf
-/

#print TopologicalLattice /-
/-- Let `L` be a lattice equipped with a topology such that `L` has continuous infimum and supremum.
Then `L` is said to be a *topological lattice*.
-/
class TopologicalLattice (L : Type _) [TopologicalSpace L] [Lattice L] extends ContinuousInf L,
  ContinuousSup L
#align topological_lattice TopologicalLattice
-/

#print OrderDual.topologicalLattice /-
-- see Note [lower instance priority]
instance (priority := 100) OrderDual.topologicalLattice (L : Type _) [TopologicalSpace L]
    [Lattice L] [TopologicalLattice L] : TopologicalLattice Lᵒᵈ where
#align order_dual.topological_lattice OrderDual.topologicalLattice
-/

#print LinearOrder.topologicalLattice /-
-- see Note [lower instance priority]
instance (priority := 100) LinearOrder.topologicalLattice {L : Type _} [TopologicalSpace L]
    [LinearOrder L] [OrderClosedTopology L] : TopologicalLattice L
    where
  continuous_inf := continuous_min
  continuous_sup := continuous_max
#align linear_order.topological_lattice LinearOrder.topologicalLattice
-/

variable {L : Type _} [TopologicalSpace L]

variable {X : Type _} [TopologicalSpace X]

/- warning: continuous_inf -> continuous_inf is a dubious translation:
lean 3 declaration is
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] [_inst_3 : Inf.{u1} L] [_inst_4 : ContinuousInf.{u1} L _inst_1 _inst_3], Continuous.{u1, u1} (Prod.{u1, u1} L L) L (Prod.topologicalSpace.{u1, u1} L L _inst_1 _inst_1) _inst_1 (fun (p : Prod.{u1, u1} L L) => Inf.inf.{u1} L _inst_3 (Prod.fst.{u1, u1} L L p) (Prod.snd.{u1, u1} L L p))
but is expected to have type
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] [_inst_3 : Inf.{u1} L] [_inst_4 : ContinuousInf.{u1} L _inst_1 _inst_3], Continuous.{u1, u1} (Prod.{u1, u1} L L) L (instTopologicalSpaceProd.{u1, u1} L L _inst_1 _inst_1) _inst_1 (fun (p : Prod.{u1, u1} L L) => Inf.inf.{u1} L _inst_3 (Prod.fst.{u1, u1} L L p) (Prod.snd.{u1, u1} L L p))
Case conversion may be inaccurate. Consider using '#align continuous_inf continuous_infₓ'. -/
@[continuity]
theorem continuous_inf [Inf L] [ContinuousInf L] : Continuous fun p : L × L => p.1 ⊓ p.2 :=
  ContinuousInf.continuous_inf
#align continuous_inf continuous_inf

/- warning: continuous.inf -> Continuous.inf is a dubious translation:
lean 3 declaration is
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] {X : Type.{u2}} [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : Inf.{u1} L] [_inst_4 : ContinuousInf.{u1} L _inst_1 _inst_3] {f : X -> L} {g : X -> L}, (Continuous.{u2, u1} X L _inst_2 _inst_1 f) -> (Continuous.{u2, u1} X L _inst_2 _inst_1 g) -> (Continuous.{u2, u1} X L _inst_2 _inst_1 (fun (x : X) => Inf.inf.{u1} L _inst_3 (f x) (g x)))
but is expected to have type
  forall {L : Type.{u2}} {_inst_1 : Type.{u1}} [X : TopologicalSpace.{u2} L] [_inst_2 : TopologicalSpace.{u1} _inst_1] [_inst_3 : Inf.{u2} L] [_inst_4 : ContinuousInf.{u2} L X _inst_3] {f : _inst_1 -> L} {g : _inst_1 -> L}, (Continuous.{u1, u2} _inst_1 L _inst_2 X f) -> (Continuous.{u1, u2} _inst_1 L _inst_2 X g) -> (Continuous.{u1, u2} _inst_1 L _inst_2 X (fun (x : _inst_1) => Inf.inf.{u2} L _inst_3 (f x) (g x)))
Case conversion may be inaccurate. Consider using '#align continuous.inf Continuous.infₓ'. -/
@[continuity]
theorem Continuous.inf [Inf L] [ContinuousInf L] {f g : X → L} (hf : Continuous f)
    (hg : Continuous g) : Continuous fun x => f x ⊓ g x :=
  continuous_inf.comp (hf.prod_mk hg : _)
#align continuous.inf Continuous.inf

/- warning: continuous_sup -> continuous_sup is a dubious translation:
lean 3 declaration is
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] [_inst_3 : Sup.{u1} L] [_inst_4 : ContinuousSup.{u1} L _inst_1 _inst_3], Continuous.{u1, u1} (Prod.{u1, u1} L L) L (Prod.topologicalSpace.{u1, u1} L L _inst_1 _inst_1) _inst_1 (fun (p : Prod.{u1, u1} L L) => Sup.sup.{u1} L _inst_3 (Prod.fst.{u1, u1} L L p) (Prod.snd.{u1, u1} L L p))
but is expected to have type
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] [_inst_3 : Sup.{u1} L] [_inst_4 : ContinuousSup.{u1} L _inst_1 _inst_3], Continuous.{u1, u1} (Prod.{u1, u1} L L) L (instTopologicalSpaceProd.{u1, u1} L L _inst_1 _inst_1) _inst_1 (fun (p : Prod.{u1, u1} L L) => Sup.sup.{u1} L _inst_3 (Prod.fst.{u1, u1} L L p) (Prod.snd.{u1, u1} L L p))
Case conversion may be inaccurate. Consider using '#align continuous_sup continuous_supₓ'. -/
@[continuity]
theorem continuous_sup [Sup L] [ContinuousSup L] : Continuous fun p : L × L => p.1 ⊔ p.2 :=
  ContinuousSup.continuous_sup
#align continuous_sup continuous_sup

/- warning: continuous.sup -> Continuous.sup is a dubious translation:
lean 3 declaration is
  forall {L : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} L] {X : Type.{u2}} [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : Sup.{u1} L] [_inst_4 : ContinuousSup.{u1} L _inst_1 _inst_3] {f : X -> L} {g : X -> L}, (Continuous.{u2, u1} X L _inst_2 _inst_1 f) -> (Continuous.{u2, u1} X L _inst_2 _inst_1 g) -> (Continuous.{u2, u1} X L _inst_2 _inst_1 (fun (x : X) => Sup.sup.{u1} L _inst_3 (f x) (g x)))
but is expected to have type
  forall {L : Type.{u2}} {_inst_1 : Type.{u1}} [X : TopologicalSpace.{u2} L] [_inst_2 : TopologicalSpace.{u1} _inst_1] [_inst_3 : Sup.{u2} L] [_inst_4 : ContinuousSup.{u2} L X _inst_3] {f : _inst_1 -> L} {g : _inst_1 -> L}, (Continuous.{u1, u2} _inst_1 L _inst_2 X f) -> (Continuous.{u1, u2} _inst_1 L _inst_2 X g) -> (Continuous.{u1, u2} _inst_1 L _inst_2 X (fun (x : _inst_1) => Sup.sup.{u2} L _inst_3 (f x) (g x)))
Case conversion may be inaccurate. Consider using '#align continuous.sup Continuous.supₓ'. -/
@[continuity]
theorem Continuous.sup [Sup L] [ContinuousSup L] {f g : X → L} (hf : Continuous f)
    (hg : Continuous g) : Continuous fun x => f x ⊔ g x :=
  continuous_sup.comp (hf.prod_mk hg : _)
#align continuous.sup Continuous.sup

/- warning: filter.tendsto.sup_right_nhds' -> Filter.Tendsto.sup_right_nhds' is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {β : Type.{u2}} [_inst_3 : TopologicalSpace.{u2} β] [_inst_4 : Sup.{u2} β] [_inst_5 : ContinuousSup.{u2} β _inst_3 _inst_4] {l : Filter.{u1} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u1, u2} ι β f l (nhds.{u2} β _inst_3 x)) -> (Filter.Tendsto.{u1, u2} ι β g l (nhds.{u2} β _inst_3 y)) -> (Filter.Tendsto.{u1, u2} ι β (Sup.sup.{max u1 u2} (ι -> β) (Pi.hasSup.{u1, u2} ι (fun (ᾰ : ι) => β) (fun (i : ι) => _inst_4)) f g) l (nhds.{u2} β _inst_3 (Sup.sup.{u2} β _inst_4 x y)))
but is expected to have type
  forall {ι : Type.{u2}} {β : Type.{u1}} [_inst_3 : TopologicalSpace.{u1} β] [_inst_4 : Sup.{u1} β] [_inst_5 : ContinuousSup.{u1} β _inst_3 _inst_4] {l : Filter.{u2} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u2, u1} ι β f l (nhds.{u1} β _inst_3 x)) -> (Filter.Tendsto.{u2, u1} ι β g l (nhds.{u1} β _inst_3 y)) -> (Filter.Tendsto.{u2, u1} ι β (Sup.sup.{max u1 u2} (ι -> β) (Pi.instSupForAll.{u2, u1} ι (fun (ᾰ : ι) => β) (fun (i : ι) => _inst_4)) f g) l (nhds.{u1} β _inst_3 (Sup.sup.{u1} β _inst_4 x y)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.sup_right_nhds' Filter.Tendsto.sup_right_nhds'ₓ'. -/
theorem Filter.Tendsto.sup_right_nhds' {ι β} [TopologicalSpace β] [Sup β] [ContinuousSup β]
    {l : Filter ι} {f g : ι → β} {x y : β} (hf : Tendsto f l (𝓝 x)) (hg : Tendsto g l (𝓝 y)) :
    Tendsto (f ⊔ g) l (𝓝 (x ⊔ y)) :=
  (continuous_sup.Tendsto _).comp (Tendsto.prod_mk_nhds hf hg)
#align filter.tendsto.sup_right_nhds' Filter.Tendsto.sup_right_nhds'

/- warning: filter.tendsto.sup_right_nhds -> Filter.Tendsto.sup_right_nhds is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {β : Type.{u2}} [_inst_3 : TopologicalSpace.{u2} β] [_inst_4 : Sup.{u2} β] [_inst_5 : ContinuousSup.{u2} β _inst_3 _inst_4] {l : Filter.{u1} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u1, u2} ι β f l (nhds.{u2} β _inst_3 x)) -> (Filter.Tendsto.{u1, u2} ι β g l (nhds.{u2} β _inst_3 y)) -> (Filter.Tendsto.{u1, u2} ι β (fun (i : ι) => Sup.sup.{u2} β _inst_4 (f i) (g i)) l (nhds.{u2} β _inst_3 (Sup.sup.{u2} β _inst_4 x y)))
but is expected to have type
  forall {ι : Type.{u2}} {β : Type.{u1}} [_inst_3 : TopologicalSpace.{u1} β] [_inst_4 : Sup.{u1} β] [_inst_5 : ContinuousSup.{u1} β _inst_3 _inst_4] {l : Filter.{u2} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u2, u1} ι β f l (nhds.{u1} β _inst_3 x)) -> (Filter.Tendsto.{u2, u1} ι β g l (nhds.{u1} β _inst_3 y)) -> (Filter.Tendsto.{u2, u1} ι β (fun (i : ι) => Sup.sup.{u1} β _inst_4 (f i) (g i)) l (nhds.{u1} β _inst_3 (Sup.sup.{u1} β _inst_4 x y)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.sup_right_nhds Filter.Tendsto.sup_right_nhdsₓ'. -/
theorem Filter.Tendsto.sup_right_nhds {ι β} [TopologicalSpace β] [Sup β] [ContinuousSup β]
    {l : Filter ι} {f g : ι → β} {x y : β} (hf : Tendsto f l (𝓝 x)) (hg : Tendsto g l (𝓝 y)) :
    Tendsto (fun i => f i ⊔ g i) l (𝓝 (x ⊔ y)) :=
  hf.sup_right_nhds' hg
#align filter.tendsto.sup_right_nhds Filter.Tendsto.sup_right_nhds

/- warning: filter.tendsto.inf_right_nhds' -> Filter.Tendsto.inf_right_nhds' is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {β : Type.{u2}} [_inst_3 : TopologicalSpace.{u2} β] [_inst_4 : Inf.{u2} β] [_inst_5 : ContinuousInf.{u2} β _inst_3 _inst_4] {l : Filter.{u1} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u1, u2} ι β f l (nhds.{u2} β _inst_3 x)) -> (Filter.Tendsto.{u1, u2} ι β g l (nhds.{u2} β _inst_3 y)) -> (Filter.Tendsto.{u1, u2} ι β (Inf.inf.{max u1 u2} (ι -> β) (Pi.hasInf.{u1, u2} ι (fun (ᾰ : ι) => β) (fun (i : ι) => _inst_4)) f g) l (nhds.{u2} β _inst_3 (Inf.inf.{u2} β _inst_4 x y)))
but is expected to have type
  forall {ι : Type.{u2}} {β : Type.{u1}} [_inst_3 : TopologicalSpace.{u1} β] [_inst_4 : Inf.{u1} β] [_inst_5 : ContinuousInf.{u1} β _inst_3 _inst_4] {l : Filter.{u2} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u2, u1} ι β f l (nhds.{u1} β _inst_3 x)) -> (Filter.Tendsto.{u2, u1} ι β g l (nhds.{u1} β _inst_3 y)) -> (Filter.Tendsto.{u2, u1} ι β (Inf.inf.{max u1 u2} (ι -> β) (Pi.instInfForAll.{u2, u1} ι (fun (ᾰ : ι) => β) (fun (i : ι) => _inst_4)) f g) l (nhds.{u1} β _inst_3 (Inf.inf.{u1} β _inst_4 x y)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.inf_right_nhds' Filter.Tendsto.inf_right_nhds'ₓ'. -/
theorem Filter.Tendsto.inf_right_nhds' {ι β} [TopologicalSpace β] [Inf β] [ContinuousInf β]
    {l : Filter ι} {f g : ι → β} {x y : β} (hf : Tendsto f l (𝓝 x)) (hg : Tendsto g l (𝓝 y)) :
    Tendsto (f ⊓ g) l (𝓝 (x ⊓ y)) :=
  (continuous_inf.Tendsto _).comp (Tendsto.prod_mk_nhds hf hg)
#align filter.tendsto.inf_right_nhds' Filter.Tendsto.inf_right_nhds'

/- warning: filter.tendsto.inf_right_nhds -> Filter.Tendsto.inf_right_nhds is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {β : Type.{u2}} [_inst_3 : TopologicalSpace.{u2} β] [_inst_4 : Inf.{u2} β] [_inst_5 : ContinuousInf.{u2} β _inst_3 _inst_4] {l : Filter.{u1} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u1, u2} ι β f l (nhds.{u2} β _inst_3 x)) -> (Filter.Tendsto.{u1, u2} ι β g l (nhds.{u2} β _inst_3 y)) -> (Filter.Tendsto.{u1, u2} ι β (fun (i : ι) => Inf.inf.{u2} β _inst_4 (f i) (g i)) l (nhds.{u2} β _inst_3 (Inf.inf.{u2} β _inst_4 x y)))
but is expected to have type
  forall {ι : Type.{u2}} {β : Type.{u1}} [_inst_3 : TopologicalSpace.{u1} β] [_inst_4 : Inf.{u1} β] [_inst_5 : ContinuousInf.{u1} β _inst_3 _inst_4] {l : Filter.{u2} ι} {f : ι -> β} {g : ι -> β} {x : β} {y : β}, (Filter.Tendsto.{u2, u1} ι β f l (nhds.{u1} β _inst_3 x)) -> (Filter.Tendsto.{u2, u1} ι β g l (nhds.{u1} β _inst_3 y)) -> (Filter.Tendsto.{u2, u1} ι β (fun (i : ι) => Inf.inf.{u1} β _inst_4 (f i) (g i)) l (nhds.{u1} β _inst_3 (Inf.inf.{u1} β _inst_4 x y)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.inf_right_nhds Filter.Tendsto.inf_right_nhdsₓ'. -/
theorem Filter.Tendsto.inf_right_nhds {ι β} [TopologicalSpace β] [Inf β] [ContinuousInf β]
    {l : Filter ι} {f g : ι → β} {x y : β} (hf : Tendsto f l (𝓝 x)) (hg : Tendsto g l (𝓝 y)) :
    Tendsto (fun i => f i ⊓ g i) l (𝓝 (x ⊓ y)) :=
  hf.inf_right_nhds' hg
#align filter.tendsto.inf_right_nhds Filter.Tendsto.inf_right_nhds


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable (G : Type*) [graph G] :
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∈ G.E) ↔
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∈ G.E,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  obtain ⟨V1,V2,h2⟩ := h1,
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V1 → (v1,v2) ∉ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V1) (hv2 : v2 ∈ V1),
    by {
      have h4 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h5 : (v1,v2) ∈ G.E, from h2 v1 v2 h4,
      show (v1,v2) ∉ G.E, from by {apply not_mem_of_mem_not h5,},
    },
  have h4 : ∀ (v1 v2 : G), v1 ∈ V2 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V2) (hv2 : v2 ∈ V2),
    by {
      have h5 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h6 : (v1,v2) ∈ G.E, from h2 v1 v2 h5,
      show (v1,v2) ∉ G.E, from by {apply not_mem_of_mem_not h6,},
    },
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V1) (hv2 : v2 ∈ V2),
    by {
      have h6 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h7 : (v1,v2) ∈ G.E, from h2 v1 v2 h6,
      show (v1,v2) ∉ G.E, from by {apply not_mem_of_mem_not h7,},
    },
  have h6 : ∀ (v1 v2 : G), v1 ∈ V2 ∧ v2 ∈ V1 → (v1,v2) ∉ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V2) (hv2 : v2 ∈ V1),
    by {
      have h7 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h8 : (v1,v2) ∈ G.E, from h2 v1 v2 h7,
      show (v1,v2) ∉ G.E, from by {apply not_mem_of_mem_not h8,},
    },
  show ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E, from by {
    use V1, use V2,
    show ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E, from by {
      assume (v1 v2 : G) (hv1 : v1 ∈ V1) (hv2 : v2 ∈ V2),
      cases (hv1), cases (hv2),
      show (v1,v2) ∉ G.E, from by {
        cases h, cases h_1,
        apply h5,
        split, exact h_a, exact h_a_1,
      },
    },
  },

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h1 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∉ G.E,
  obtain ⟨V1,V2,h2⟩ := h1,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h3 : ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∈ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V1) (hv2 : v2 ∈ V2),
    by {
      have h4 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h5 : (v1,v2) ∉ G.E, from h2 v1 v2 h4,
      show (v1,v2) ∈ G.E, from by {apply mem_of_mem_not h5,},
    },
  have h4 : ∀ (v1 v2 : G), v1 ∈ V2 ∧ v2 ∈ V1 → (v1,v2) ∈ G.E, from assume (v1 v2 : G) (hv1 : v1 ∈ V2) (hv2 : v2 ∈ V1),
    by {
      have h5 : v1 ∈ V1 ∧ v2 ∈ V2, from by {split,exact hv1,exact hv2},
      have h6 : (v1,v2) ∉ G.E, from h2 v1 v2 h5,
      show (v1,v2) ∈ G.E, from by {apply mem_of_mem_not h6,},
    },
  show ∃ (V1 V2 : set G), ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∈ G.E, from by {
    use V1, use V2,
    show ∀ (v1 v2 : G), v1 ∈ V1 ∧ v2 ∈ V2 → (v1,v2) ∈ G.E, from by {
      assume (v1 v2 : G) (hv1 : v1 ∈ V1) (hv2 : v2 ∈ V2),
      cases (hv1), cases (hv2),
      show (v
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import data.fintype.basic
import tactic
import matroid
import finset

variables {α : Type*} [fintype α] [decidable_eq α] {m : matroid α} {A B X: finset α}

open finset

namespace matroid

lemma base_of_refl_iff_ind : m.ind A ↔ m.base_of A A :=
begin
  split, {
    intro Aind,
    refine ⟨subset.refl _, Aind, λ x hnx hx, absurd hx hnx⟩,
  }, {
    exact λ hb, hb.2.1,
  }
end

lemma base_of_eq_card (hA : m.base_of X A) (hB : m.base_of X B) : A.card = B.card :=
begin
  by_contradiction,
  wlog : A.card ≤ B.card := le_total A.card B.card using [A B, B A],
  replace h := nat.lt_of_le_and_ne case h,
  obtain ⟨w, wB, wA, winsert⟩ := m.ind_exchange _ _ (base_of_ind hA) (base_of_ind hB) h,
  refine hA.2.2 w wA (base_of_subset hB wB) winsert,
end

lemma ind_subset_base_of : A ⊆ X → m.ind A → ∃ B, A ⊆ B ∧ m.base_of X B :=
begin
  intros hAX hA,
  by_contradiction,
  push_neg at h,
  suffices ind_unbounded : ∀ k ≥ A.card, ∃ B, A ⊆ B ∧ B ⊆ X ∧ m.ind B ∧ B.card = k, {
    rcases ind_unbounded (X.card + 1) _ with ⟨B, hAB, hBX, Bind, Bcard⟩,
    replace hBX := card_le_of_subset hBX,
    linarith,
    replace hAX := card_le_of_subset hAX,
    linarith,
  },
  apply nat.le_induction, {
    use [A, subset.refl A, hAX, hA],
  }, {
    rintro n Acard ⟨B, hAB, hBX, Bind, rfl⟩,
    specialize h B hAB,
    rw base_of at h,
    push_neg at h,
    rcases h hBX Bind with ⟨w, wB, wX, w_insert⟩,
    use [insert w B],
    use [subset.trans hAB (subset_insert _ _)],
    use [insert_subset.2 ⟨wX, hBX⟩],
    use [w_insert, card_insert_of_not_mem wB],
  }
end

theorem exists_base_of (m : matroid α) (X : finset α): ∃ A, m.base_of X A :=
begin
  obtain ⟨B, _, Bbase⟩ := ind_subset_base_of (empty_subset X) m.ind_empty,
  exact ⟨B, Bbase⟩,
end

lemma ind_card_le_base_of_card : (A ⊆ X) → m.ind A → m.base_of X B → A.card ≤ B.card :=
begin
  intros hAX Aind Bbase,
  obtain ⟨T, hAT, Tbase⟩ := ind_subset_base_of hAX Aind,
  rw base_of_eq_card Bbase Tbase,
  exact card_le_of_subset hAT,
end

end matroid


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

/-!
# Algebraic structures on the set of positive numbers

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

In this file we define various instances (`add_semigroup`, `ordered_comm_monoid` etc) on the
type `{x : R // 0 < x}`. In each case we try to require the weakest possible typeclass
assumptions on `R` but possibly, there is a room for improvements.
-/
open function

namespace positive

variables {M R K : Type*}

section add_basic

variables [add_monoid M] [preorder M] [covariant_class M M (+) (<)]

instance : has_add {x : M // 0 < x} := ⟨λ x y, ⟨x + y, add_pos x.2 y.2⟩⟩

@[simp, norm_cast] lemma coe_add (x y : {x : M // 0 < x}) : ↑(x + y) = (x + y : M) := rfl

instance : add_semigroup {x : M // 0 < x} := subtype.coe_injective.add_semigroup _ coe_add

instance {M : Type*} [add_comm_monoid M] [preorder M] [covariant_class M M (+) (<)] :
  add_comm_semigroup {x : M // 0 < x} :=
subtype.coe_injective.add_comm_semigroup _ coe_add

instance {M : Type*} [add_left_cancel_monoid M] [preorder M] [covariant_class M M (+) (<)] :
  add_left_cancel_semigroup {x : M // 0 < x} :=
subtype.coe_injective.add_left_cancel_semigroup _ coe_add

instance {M : Type*} [add_right_cancel_monoid M] [preorder M] [covariant_class M M (+) (<)] :
  add_right_cancel_semigroup {x : M // 0 < x} :=
subtype.coe_injective.add_right_cancel_semigroup _ coe_add

instance covariant_class_add_lt : covariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (<) :=
⟨λ x y z hyz, subtype.coe_lt_coe.1 $ add_lt_add_left hyz _⟩

instance covariant_class_swap_add_lt [covariant_class M M (swap (+)) (<)] :
  covariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (<) :=
⟨λ x y z hyz, subtype.coe_lt_coe.1 $ add_lt_add_right hyz _⟩

instance contravariant_class_add_lt [contravariant_class M M (+) (<)] :
  contravariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (<) :=
⟨λ x y z h, subtype.coe_lt_coe.1 $ lt_of_add_lt_add_left h⟩

instance contravariant_class_swap_add_lt [contravariant_class M M (swap (+)) (<)] :
  contravariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (<) :=
⟨λ x y z h, subtype.coe_lt_coe.1 $ lt_of_add_lt_add_right h⟩

instance contravariant_class_add_le [contravariant_class M M (+) (≤)] :
  contravariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (≤) :=
⟨λ x y z h, subtype.coe_le_coe.1 $ le_of_add_le_add_left h⟩

instance contravariant_class_swap_add_le [contravariant_class M M (swap (+)) (≤)] :
  contravariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (≤) :=
⟨λ x y z h, subtype.coe_le_coe.1 $ le_of_add_le_add_right h⟩

end add_basic

instance covariant_class_add_le [add_monoid M] [partial_order M] [covariant_class M M (+) (<)] :
  covariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (≤) :=
⟨λ x, strict_mono.monotone $ λ _ _ h, add_lt_add_left h _⟩

section mul

variables [strict_ordered_semiring R]

instance : has_mul {x : R // 0 < x} := ⟨λ x y, ⟨x * y, mul_pos x.2 y.2⟩⟩

@[simp] lemma coe_mul (x y : {x : R // 0 < x}) : ↑(x * y) = (x * y : R) := rfl

instance : has_pow {x : R // 0 < x} ℕ := ⟨λ x n, ⟨x ^ n, pow_pos x.2 n⟩⟩

@[simp] lemma coe_pow (x : {x : R // 0 < x}) (n : ℕ) : ↑(x ^ n) = (x ^ n : R) := rfl

instance : semigroup {x : R // 0 < x} := subtype.coe_injective.semigroup coe coe_mul

instance : distrib {x : R // 0 < x} := subtype.coe_injective.distrib _ coe_add coe_mul

instance [nontrivial R] : has_one {x : R // 0 < x} := ⟨⟨1, one_pos⟩⟩

@[simp] lemma coe_one [nontrivial R] : ((1 : {x : R // 0 < x}) : R) = 1 := rfl

instance [nontrivial R] : monoid {x : R // 0 < x} :=
subtype.coe_injective.monoid _ coe_one coe_mul coe_pow

end mul

section mul_comm

instance [strict_ordered_comm_semiring R] [nontrivial R] : ordered_comm_monoid {x : R // 0 < x} :=
{ mul_le_mul_left := λ x y hxy c, subtype.coe_le_coe.1 $ mul_le_mul_of_nonneg_left hxy c.2.le,
  .. subtype.partial_order _,
  .. subtype.coe_injective.comm_monoid (coe : {x : R // 0 < x} → R) coe_one coe_mul coe_pow }

/-- If `R` is a nontrivial linear ordered commutative semiring, then `{x : R // 0 < x}` is a linear
ordered cancellative commutative monoid. -/
instance [linear_ordered_comm_semiring R] : linear_ordered_cancel_comm_monoid {x : R // 0 < x} :=
{ le_of_mul_le_mul_left := λ a b c h, subtype.coe_le_coe.1 $ (mul_le_mul_left a.2).1 h,
  .. subtype.linear_order _, .. positive.subtype.ordered_comm_monoid  }

end mul_comm

end positive


constant g (x y : Nat) : Nat
constant f (x y : Nat) : Nat
axiom f_def (x y : Nat) : f x y = g x y
axiom f_ax (x : Nat) : f x x = x

theorem ex1 (x : Nat) : g x x = x := by
  simp [← f_def, f_ax]

constant p (x y : Nat) : Prop
constant q (x y : Nat) : Prop
axiom p_def (x y : Nat) : p x y ↔ q x y
axiom p_ax (x : Nat) : p x x

theorem ex2 (x : Nat) : q x x := by
  simp [← p_def, p_ax]


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.pointwise
import linear_algebra.basic

/-! # Pointwise instances on `submodule`s

This file provides the actions

* `submodule.pointwise_distrib_mul_action`
* `submodule.pointwise_mul_action_with_zero`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.
-/

namespace submodule

variables {α : Type*} {R : Type*} {M : Type*}
variables [semiring R] [add_comm_monoid M] [module R M]

instance pointwise_add_comm_monoid : add_comm_monoid (submodule R M) :=
{ add := (⊔),
  add_assoc := λ _ _ _, sup_assoc,
  zero := ⊥,
  zero_add := λ _, bot_sup_eq,
  add_zero := λ _, sup_bot_eq,
  add_comm := λ _ _, sup_comm }

@[simp] lemma add_eq_sup (p q : submodule R M) : p + q = p ⊔ q := rfl
@[simp] lemma zero_eq_bot : (0 : submodule R M) = ⊥ := rfl

section
variables [monoid α] [distrib_mul_action α M] [smul_comm_class α R M]

/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_distrib_mul_action : distrib_mul_action α (submodule R M) :=
{ smul := λ a S, S.map (distrib_mul_action.to_linear_map _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (linear_map.ext $ by exact one_smul α)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact mul_smul _ _)).trans
      (S.map_comp _ _),
  smul_zero := λ a, map_bot _,
  smul_add := λ a S₁ S₂, map_sup _ _ _ }

localized "attribute [instance] submodule.pointwise_distrib_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submodule R M) : ↑(a • S) = a • (S : set M) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : submodule R M) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

@[simp] lemma pointwise_smul_to_add_subgroup {R M : Type*}
  [ring R] [add_comm_group M] [distrib_mul_action α M] [module R M] [smul_comm_class α R M]
  (a : α) (S : submodule R M) :
  (a • S).to_add_subgroup = a • S.to_add_subgroup := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

@[simp] lemma smul_le_self_of_tower {α : Type*}
  [semiring α] [module α R] [module α M] [smul_comm_class α R M] [is_scalar_tower α R M]
  (a : α) (S : submodule R M) : a • S ≤ S :=
begin
  rintro y ⟨x, hx, rfl⟩,
  exact smul_of_tower_mem _ a hx,
end

end

section
variables [semiring α] [module α M] [smul_comm_class α R M]
/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale.

This is a stronger version of `submodule.pointwise_distrib_mul_action`. Note that `add_smul` does
not hold so this cannot be stated as a `module`. -/
protected def pointwise_mul_action_with_zero : mul_action_with_zero α (submodule R M) :=
{ zero_smul := λ S,
    (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact zero_smul α)).trans S.map_zero,
  .. submodule.pointwise_distrib_mul_action }

localized "attribute [instance] submodule.pointwise_mul_action_with_zero" in pointwise

end

end submodule


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import order.antichain
import order.order_iso_nat
import order.well_founded
import tactic.tfae

/-!
# Well-founded sets

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

A well-founded subset of an ordered type is one on which the relation `<` is well-founded.

## Main Definitions
 * `set.well_founded_on s r` indicates that the relation `r` is
  well-founded when restricted to the set `s`.
 * `set.is_wf s` indicates that `<` is well-founded when restricted to `s`.
 * `set.partially_well_ordered_on s r` indicates that the relation `r` is
  partially well-ordered (also known as well quasi-ordered) when restricted to the set `s`.
 * `set.is_pwo s` indicates that any infinite sequence of elements in `s` contains an infinite
  monotone subsequence. Note that this is equivalent to containing only two comparable elements.

## Main Results
 * Higman's Lemma, `set.partially_well_ordered_on.partially_well_ordered_on_sublist_forall₂`,
  shows that if `r` is partially well-ordered on `s`, then `list.sublist_forall₂` is partially
  well-ordered on the set of lists of elements of `s`. The result was originally published by
  Higman, but this proof more closely follows Nash-Williams.
 * `set.well_founded_on_iff` relates `well_founded_on` to the well-foundedness of a relation on the
 original type, to avoid dealing with subtypes.
 * `set.is_wf.mono` shows that a subset of a well-founded subset is well-founded.
 * `set.is_wf.union` shows that the union of two well-founded subsets is well-founded.
 * `finset.is_wf` shows that all `finset`s are well-founded.

## TODO

Prove that `s` is partial well ordered iff it has no infinite descending chain or antichain.

## References
 * [Higman, *Ordering by Divisibility in Abstract Algebras*][Higman52]
 * [Nash-Williams, *On Well-Quasi-Ordering Finite Trees*][Nash-Williams63]
-/

variables {ι α β : Type*}

namespace set

/-! ### Relations well-founded on sets -/

/-- `s.well_founded_on r` indicates that the relation `r` is well-founded when restricted to `s`. -/
def well_founded_on (s : set α) (r : α → α → Prop) : Prop := well_founded $ λ a b : s, r a b

@[simp] lemma well_founded_on_empty (r : α → α → Prop) : well_founded_on ∅ r :=
well_founded_of_empty _

section well_founded_on
variables {r r' : α → α → Prop}

section any_rel
variables {s t : set α} {x y : α}

lemma well_founded_on_iff :
  s.well_founded_on r ↔ well_founded (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
begin
  have f : rel_embedding (λ (a : s) (b : s), r a b) (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
    ⟨⟨coe, subtype.coe_injective⟩, λ a b, by simp⟩,
  refine ⟨λ h, _, f.well_founded⟩,
  rw well_founded.well_founded_iff_has_min,
  intros t ht,
  by_cases hst : (s ∩ t).nonempty,
  { rw ← subtype.preimage_coe_nonempty at hst,
    rcases h.has_min (coe ⁻¹' t) hst with ⟨⟨m, ms⟩, mt, hm⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hm ⟨x, xs⟩ xt xm⟩ },
  { rcases ht with ⟨m, mt⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hst ⟨m, ⟨ms, mt⟩⟩⟩ }
end

namespace well_founded_on

protected lemma induction (hs : s.well_founded_on r) (hx : x ∈ s) {P : α → Prop}
  (hP : ∀ y ∈ s, (∀ z ∈ s, r z y → P z) → P y) : P x :=
begin
  let Q : s → Prop := λ y, P y,
  change Q ⟨x, hx⟩,
  refine well_founded.induction hs ⟨x, hx⟩ _,
  simpa only [subtype.forall]
end

protected lemma mono (h : t.well_founded_on r') (hle : r ≤ r') (hst : s ⊆ t) :
  s.well_founded_on r :=
begin
  rw well_founded_on_iff at *,
  refine subrelation.wf (λ x y xy, _) h,
  exact ⟨hle _ _ xy.1, hst xy.2.1, hst xy.2.2⟩
end

lemma subset (h : t.well_founded_on r) (hst : s ⊆ t) : s.well_founded_on r := h.mono le_rfl hst

open relation

/-- `a` is accessible under the relation `r` iff `r` is well-founded on the downward transitive
  closure of `a` under `r` (including `a` or not). -/
lemma acc_iff_well_founded_on {α} {r : α → α → Prop} {a : α} :
  [ acc r a,
    {b | refl_trans_gen r b a}.well_founded_on r,
    {b | trans_gen r b a}.well_founded_on r ].tfae :=
begin
  tfae_have : 1 → 2,
  { refine λ h, ⟨λ b, _⟩, apply inv_image.accessible,
    rw ← acc_trans_gen_iff at h ⊢,
    obtain h'|h' := refl_trans_gen_iff_eq_or_trans_gen.1 b.2,
    { rwa h' at h }, { exact h.inv h' } },
  tfae_have : 2 → 3,
  { exact λ h, h.subset (λ _, trans_gen.to_refl) },
  tfae_have : 3 → 1,
  { refine λ h, acc.intro _ (λ b hb, (h.apply ⟨b, trans_gen.single hb⟩).of_fibration subtype.val _),
    exact λ ⟨c, hc⟩ d h, ⟨⟨d, trans_gen.head h hc⟩, h, rfl⟩ },
  tfae_finish,
end

end well_founded_on
end any_rel

section is_strict_order
variables [is_strict_order α r] {s t : set α}

instance is_strict_order.subset : is_strict_order α (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
{ to_is_irrefl := ⟨λ a con, irrefl_of r a con.1 ⟩,
  to_is_trans := ⟨λ a b c ab bc, ⟨trans_of r ab.1 bc.1, ab.2.1, bc.2.2⟩ ⟩ }

lemma well_founded_on_iff_no_descending_seq :
  s.well_founded_on r ↔ ∀ (f : ((>) : ℕ → ℕ → Prop) ↪r r), ¬∀ n, f n ∈ s :=
begin
  simp only [well_founded_on_iff, rel_embedding.well_founded_iff_no_descending_seq, ← not_exists,
    ← not_nonempty_iff, not_iff_not],
  split,
  { rintro ⟨⟨f, hf⟩⟩,
    have H : ∀ n, f n ∈ s, from λ n, (hf.2 n.lt_succ_self).2.2,
    refine ⟨⟨f, _⟩, H⟩,
    simpa only [H, and_true] using @hf },
  { rintro ⟨⟨f, hf⟩, hfs : ∀ n, f n ∈ s⟩,
    refine ⟨⟨f, _⟩⟩,
    simpa only [hfs, and_true] using @hf }
end

lemma well_founded_on.union (hs : s.well_founded_on r) (ht : t.well_founded_on r) :
  (s ∪ t).well_founded_on r :=
begin
  rw well_founded_on_iff_no_descending_seq at *,
  rintro f hf,
  rcases nat.exists_subseq_of_forall_mem_union f hf with ⟨g, hg|hg⟩,
  exacts [hs (g.dual.lt_embedding.trans f) hg, ht (g.dual.lt_embedding.trans f) hg]
end

@[simp] lemma well_founded_on_union :
  (s ∪ t).well_founded_on r ↔ s.well_founded_on r ∧ t.well_founded_on r :=
⟨λ h, ⟨h.subset $ subset_union_left _ _, h.subset $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩

end is_strict_order
end well_founded_on

/-! ### Sets well-founded w.r.t. the strict inequality -/

section has_lt
variables [has_lt α] {s t : set α}

/-- `s.is_wf` indicates that `<` is well-founded when restricted to `s`. -/
def is_wf (s : set α) : Prop := well_founded_on s (<)

@[simp] lemma is_wf_empty : is_wf (∅ : set α) := well_founded_of_empty _

lemma is_wf_univ_iff : is_wf (univ : set α) ↔ well_founded ((<) : α → α → Prop) :=
by simp [is_wf, well_founded_on_iff]

theorem is_wf.mono (h : is_wf t) (st : s ⊆ t) : is_wf s := h.subset st

end has_lt

section preorder
variables [preorder α] {s t : set α} {a : α}

protected lemma is_wf.union (hs : is_wf s) (ht : is_wf t) : is_wf (s ∪ t) := hs.union ht

@[simp] lemma is_wf_union : is_wf (s ∪ t) ↔ is_wf s ∧ is_wf t := well_founded_on_union

end preorder

section preorder
variables [preorder α] {s t : set α} {a : α}

theorem is_wf_iff_no_descending_seq :
  is_wf s ↔ ∀ f : ℕ → α, strict_anti f → ¬(∀ n, f (order_dual.to_dual n) ∈ s) :=
well_founded_on_iff_no_descending_seq.trans
  ⟨λ H f hf, H ⟨⟨f, hf.injective⟩, λ a b, hf.lt_iff_lt⟩, λ H f, H f (λ _ _, f.map_rel_iff.2)⟩

end preorder

/-!
### Partially well-ordered sets

A set is partially well-ordered by a relation `r` when any infinite sequence contains two elements
where the first is related to the second by `r`. Equivalently, any antichain (see `is_antichain`) is
finite, see `set.partially_well_ordered_on_iff_finite_antichains`.
-/

/-- A subset is partially well-ordered by a relation `r` when any infinite sequence contains
  two elements where the first is related to the second by `r`. -/
def partially_well_ordered_on (s : set α) (r : α → α → Prop) : Prop :=
∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ m n : ℕ, m < n ∧ r (f m) (f n)

section partially_well_ordered_on
variables {r : α → α → Prop} {r' : β → β → Prop} {f : α → β} {s : set α} {t : set α} {a : α}

lemma partially_well_ordered_on.mono (ht : t.partially_well_ordered_on r) (h : s ⊆ t) :
  s.partially_well_ordered_on r :=
λ f hf, ht f $ λ n, h $ hf n

@[simp] lemma partially_well_ordered_on_empty (r : α → α → Prop) : partially_well_ordered_on ∅ r :=
λ f hf, (hf 0).elim

lemma partially_well_ordered_on.union (hs : s.partially_well_ordered_on r)
  (ht : t.partially_well_ordered_on r) :
  (s ∪ t).partially_well_ordered_on r :=
begin
  rintro f hf,
  rcases nat.exists_subseq_of_forall_mem_union f hf with ⟨g, hgs|hgt⟩,
  { rcases hs _ hgs with ⟨m, n, hlt, hr⟩,
    exact ⟨g m, g n, g.strict_mono hlt, hr⟩ },
  { rcases ht _ hgt with ⟨m, n, hlt, hr⟩,
    exact ⟨g m, g n, g.strict_mono hlt, hr⟩ }
end

@[simp] lemma partially_well_ordered_on_union :
  (s ∪ t).partially_well_ordered_on r ↔
    s.partially_well_ordered_on r ∧ t.partially_well_ordered_on r :=
⟨λ h, ⟨h.mono $ subset_union_left _ _, h.mono $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩

lemma partially_well_ordered_on.image_of_monotone_on (hs : s.partially_well_ordered_on r)
  (hf : ∀ (a₁ ∈ s) (a₂ ∈ s), r a₁ a₂ → r' (f a₁) (f a₂)) :
  (f '' s).partially_well_ordered_on r' :=
begin
  intros g' hg',
  choose g hgs heq using hg',
  obtain rfl : f ∘ g = g', from funext heq,
  obtain ⟨m, n, hlt, hmn⟩ := hs g hgs,
  exact ⟨m, n, hlt, hf _ (hgs m) _ (hgs n) hmn⟩
end

lemma _root_.is_antichain.finite_of_partially_well_ordered_on (ha : is_antichain r s)
  (hp : s.partially_well_ordered_on r) :
  s.finite :=
begin
  refine not_infinite.1 (λ hi, _),
  obtain ⟨m, n, hmn, h⟩ := hp (λ n, hi.nat_embedding _ n) (λ n, (hi.nat_embedding _ n).2),
  exact hmn.ne ((hi.nat_embedding _).injective $ subtype.val_injective $
    ha.eq (hi.nat_embedding _ m).2 (hi.nat_embedding _ n).2 h),
end

section is_refl
variables [is_refl α r]

protected lemma finite.partially_well_ordered_on (hs : s.finite) : s.partially_well_ordered_on r :=
begin
  intros f hf,
  obtain ⟨m, n, hmn, h⟩ := hs.exists_lt_map_eq_of_forall_mem hf,
  exact ⟨m, n, hmn, h.subst $ refl (f m)⟩,
end

lemma _root_.is_antichain.partially_well_ordered_on_iff (hs : is_antichain r s) :
  s.partially_well_ordered_on r ↔ s.finite :=
⟨hs.finite_of_partially_well_ordered_on, finite.partially_well_ordered_on⟩

@[simp] lemma partially_well_ordered_on_singleton (a : α) : partially_well_ordered_on {a} r :=
(finite_singleton a).partially_well_ordered_on

@[simp] lemma partially_well_ordered_on_insert :
  partially_well_ordered_on (insert a s) r ↔ partially_well_ordered_on s r :=
by simp only [← singleton_union, partially_well_ordered_on_union,
  partially_well_ordered_on_singleton, true_and]

protected lemma partially_well_ordered_on.insert (h : partially_well_ordered_on s r) (a : α) :
  partially_well_ordered_on (insert a s) r :=
partially_well_ordered_on_insert.2 h

lemma partially_well_ordered_on_iff_finite_antichains [is_symm α r] :
  s.partially_well_ordered_on r ↔ ∀ t ⊆ s, is_antichain r t → t.finite :=
begin
  refine ⟨λ h t ht hrt, hrt.finite_of_partially_well_ordered_on (h.mono ht), _⟩,
  rintro hs f hf,
  by_contra' H,
  refine infinite_range_of_injective (λ m n hmn, _) (hs _ (range_subset_iff.2 hf) _),
  { obtain h | h | h := lt_trichotomy m n,
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ },
    { exact h },
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ } },
  rintro _ ⟨m, hm, rfl⟩ _ ⟨n, hn, rfl⟩ hmn,
  obtain h | h  := (ne_of_apply_ne _ hmn).lt_or_lt,
  { exact H _ _ h },
  { exact mt symm (H _ _ h) }
end

variables [is_trans α r]

lemma partially_well_ordered_on.exists_monotone_subseq (h : s.partially_well_ordered_on r)
  (f : ℕ → α) (hf : ∀ n, f n ∈ s) :
  ∃ g : ℕ ↪o ℕ, ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  obtain ⟨g, h1 | h2⟩ := exists_increasing_or_nonincreasing_subseq r f,
  { refine ⟨g, λ m n hle, _⟩,
    obtain hlt | rfl := hle.lt_or_eq,
    exacts [h1 m n hlt, refl_of r _] },
  { exfalso,
    obtain ⟨m, n, hlt, hle⟩ := h (f ∘ g) (λ n, hf _),
    exact h2 m n hlt hle }
end

lemma partially_well_ordered_on_iff_exists_monotone_subseq :
  s.partially_well_ordered_on r ↔
    ∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  classical,
  split; intros h f hf,
  { exact h.exists_monotone_subseq f hf },
  { obtain ⟨g, gmon⟩ := h f hf,
    exact ⟨g 0, g 1, g.lt_iff_lt.2 zero_lt_one, gmon _ _ zero_le_one⟩ }
end

protected lemma partially_well_ordered_on.prod {t : set β} (hs : partially_well_ordered_on s r)
  (ht : partially_well_ordered_on t r') :
  partially_well_ordered_on (s ×ˢ t) (λ x y : α × β, r x.1 y.1 ∧ r' x.2 y.2) :=
begin
  intros f hf,
  obtain ⟨g₁, h₁⟩ := hs.exists_monotone_subseq (prod.fst ∘ f) (λ n, (hf n).1),
  obtain ⟨m, n, hlt, hle⟩ := ht (prod.snd ∘ f ∘ g₁) (λ n, (hf _).2),
  exact ⟨g₁ m, g₁ n, g₁.strict_mono hlt, h₁ _ _ hlt.le, hle⟩
end

end is_refl

lemma partially_well_ordered_on.well_founded_on [is_preorder α r]
 (h : s.partially_well_ordered_on r) :
  s.well_founded_on (λ a b, r a b ∧ ¬r b a) :=
begin
  letI : preorder α := { le := r, le_refl := refl_of r, le_trans := λ _ _ _, trans_of r },
  change s.well_founded_on (<), change s.partially_well_ordered_on (≤) at h,
  rw well_founded_on_iff_no_descending_seq,
  intros f hf,
  obtain ⟨m, n, hlt, hle⟩ := h f hf,
  exact (f.map_rel_iff.2 hlt).not_le hle,
end

end partially_well_ordered_on

section is_pwo
variables [preorder α] [preorder β] {s t : set α}

/-- A subset of a preorder is partially well-ordered when any infinite sequence contains
  a monotone subsequence of length 2 (or equivalently, an infinite monotone subsequence). -/
def is_pwo (s : set α) : Prop := partially_well_ordered_on s (≤)

lemma is_pwo.mono (ht : t.is_pwo) : s ⊆ t → s.is_pwo := ht.mono

theorem is_pwo.exists_monotone_subseq (h : s.is_pwo) (f : ℕ → α) (hf : ∀ n, f n ∈ s) :
  ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
h.exists_monotone_subseq f hf

theorem is_pwo_iff_exists_monotone_subseq :
  s.is_pwo ↔ ∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
partially_well_ordered_on_iff_exists_monotone_subseq

protected lemma is_pwo.is_wf (h : s.is_pwo) : s.is_wf :=
by simpa only [← lt_iff_le_not_le] using h.well_founded_on

lemma is_pwo.prod {t : set β} (hs : s.is_pwo) (ht : t.is_pwo) : is_pwo (s ×ˢ t) := hs.prod ht

lemma is_pwo.image_of_monotone_on (hs : s.is_pwo) {f : α → β} (hf : monotone_on f s) :
 is_pwo (f '' s) :=
hs.image_of_monotone_on hf

lemma is_pwo.image_of_monotone (hs : s.is_pwo) {f : α → β} (hf : monotone f) : is_pwo (f '' s) :=
hs.image_of_monotone_on (hf.monotone_on _)

protected lemma is_pwo.union (hs : is_pwo s) (ht : is_pwo t) : is_pwo (s ∪ t) := hs.union ht

@[simp] lemma is_pwo_union : is_pwo (s ∪ t) ↔ is_pwo s ∧ is_pwo t := partially_well_ordered_on_union

protected lemma finite.is_pwo (hs : s.finite) : is_pwo s := hs.partially_well_ordered_on
@[simp] lemma is_pwo_of_finite [finite α] : s.is_pwo := s.to_finite.is_pwo

@[simp] lemma is_pwo_singleton (a : α) : is_pwo ({a} : set α) := (finite_singleton a).is_pwo

@[simp] lemma is_pwo_empty : is_pwo (∅ : set α) := finite_empty.is_pwo

protected lemma subsingleton.is_pwo (hs : s.subsingleton) : is_pwo s := hs.finite.is_pwo

@[simp] lemma is_pwo_insert {a} : is_pwo (insert a s) ↔ is_pwo s :=
by simp only [←singleton_union, is_pwo_union, is_pwo_singleton, true_and]

protected lemma is_pwo.insert (h : is_pwo s) (a : α) : is_pwo (insert a s) := is_pwo_insert.2 h

protected lemma finite.is_wf (hs : s.finite) : is_wf s := hs.is_pwo.is_wf
@[simp] lemma is_wf_singleton {a : α} : is_wf ({a} : set α) := (finite_singleton a).is_wf
protected lemma subsingleton.is_wf (hs : s.subsingleton) : is_wf s := hs.is_pwo.is_wf

@[simp] lemma is_wf_insert {a} : is_wf (insert a s) ↔ is_wf s :=
by simp only [←singleton_union, is_wf_union, is_wf_singleton, true_and]

lemma is_wf.insert (h : is_wf s) (a : α) : is_wf (insert a s) := is_wf_insert.2 h

end is_pwo

section well_founded_on
variables {r : α → α → Prop} [is_strict_order α r] {s : set α} {a : α}

protected lemma finite.well_founded_on (hs : s.finite) : s.well_founded_on r :=
by { letI := partial_order_of_SO r, exact hs.is_wf }

@[simp] lemma well_founded_on_singleton : well_founded_on ({a} : set α) r :=
(finite_singleton a).well_founded_on

protected lemma subsingleton.well_founded_on (hs : s.subsingleton) : s.well_founded_on r :=
hs.finite.well_founded_on

@[simp] lemma well_founded_on_insert : well_founded_on (insert a s) r ↔ well_founded_on s r :=
by simp only [←singleton_union, well_founded_on_union, well_founded_on_singleton, true_and]

lemma well_founded_on.insert (h : well_founded_on s r) (a : α) : well_founded_on (insert a s) r :=
well_founded_on_insert.2 h

end well_founded_on

section linear_order
variables [linear_order α] {s : set α}

protected lemma is_wf.is_pwo (hs : s.is_wf) : s.is_pwo :=
begin
  intros f hf,
  lift f to ℕ → s using hf,
  have hrange : (range f).nonempty := range_nonempty _,
  rcases hs.has_min (range f) (range_nonempty _) with ⟨_, ⟨m, rfl⟩, hm⟩,
  simp only [forall_range_iff, not_lt] at hm,
  exact ⟨m, m + 1, lt_add_one m, hm _⟩,
end

/-- In a linear order, the predicates `set.is_wf` and `set.is_pwo` are equivalent. -/
lemma is_wf_iff_is_pwo : s.is_wf ↔ s.is_pwo := ⟨is_wf.is_pwo, is_pwo.is_wf⟩

end linear_order
end set

namespace finset
variables {r : α → α → Prop}

@[simp] protected lemma partially_well_ordered_on [is_refl α r] (s : finset α) :
  (s : set α).partially_well_ordered_on r :=
s.finite_to_set.partially_well_ordered_on

@[simp] protected lemma is_pwo [preorder α] (s : finset α) : set.is_pwo (↑s : set α) :=
s.partially_well_ordered_on

@[simp] protected lemma is_wf [preorder α] (s : finset α) : set.is_wf (↑s : set α) :=
s.finite_to_set.is_wf

@[simp] protected lemma well_founded_on [is_strict_order α r] (s : finset α) :
  set.well_founded_on (↑s : set α) r :=
by { letI := partial_order_of_SO r, exact s.is_wf }

lemma well_founded_on_sup [is_strict_order α r] (s : finset ι) {f : ι → set α} :
  (s.sup f).well_founded_on r ↔ ∀ i ∈ s, (f i).well_founded_on r :=
finset.cons_induction_on s (by simp) $ λ a s ha hs, by simp [-sup_set_eq_bUnion, hs]

lemma partially_well_ordered_on_sup (s : finset ι) {f : ι → set α} :
  (s.sup f).partially_well_ordered_on r ↔ ∀ i ∈ s, (f i).partially_well_ordered_on r :=
finset.cons_induction_on s (by simp) $ λ a s ha hs, by simp [-sup_set_eq_bUnion, hs]

lemma is_wf_sup [preorder α] (s : finset ι) {f : ι → set α} :
  (s.sup f).is_wf ↔ ∀ i ∈ s, (f i).is_wf :=
s.well_founded_on_sup

@[simp] lemma well_founded_on_bUnion [is_strict_order α r] (s : finset ι) {f : ι → set α} :
  (⋃ i ∈ s, f i).well_founded_on r ↔ ∀ i ∈ s, (f i).well_founded_on r :=
by simpa only [finset.sup_eq_supr] using s.well_founded_on_sup

@[simp] lemma partially_well_ordered_on_bUnion (s : finset ι) {f : ι → set α} :
  (⋃ i ∈ s, f i).partially_well_ordered_on r ↔ ∀ i ∈ s, (f i).partially_well_ordered_on r :=
by simpa only [finset.sup_eq_supr] using s.partially_well_ordered_on_sup

@[simp] lemma is_wf_bUnion [preorder α] (s : finset ι) {f : ι → set α} :
  (⋃ i ∈ s, f i).is_wf ↔ ∀ i ∈ s, (f i).is_wf :=
s.well_founded_on_bUnion

@[simp] lemma is_pwo_bUnion [preorder α] (s : finset ι) {f : ι → set α} :
  (⋃ i ∈ s, f i).is_pwo ↔ ∀ i ∈ s, (f i).is_pwo :=
s.partially_well_ordered_on_bUnion

end finset

namespace set
section preorder
variables [preorder α] {s : set α} {a : α}

/-- `is_wf.min` returns a minimal element of a nonempty well-founded set. -/
noncomputable def is_wf.min (hs : is_wf s) (hn : s.nonempty) : α :=
hs.min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)

lemma is_wf.min_mem (hs : is_wf s) (hn : s.nonempty) : hs.min hn ∈ s :=
(well_founded.min hs univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)).2

lemma is_wf.not_lt_min (hs : is_wf s) (hn : s.nonempty) (ha : a ∈ s) : ¬ a < hs.min hn :=
hs.not_lt_min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype) (mem_univ (⟨a, ha⟩ : s))

@[simp]
lemma is_wf_min_singleton (a) {hs : is_wf ({a} : set α)} {hn : ({a} : set α).nonempty} :
  hs.min hn = a :=
eq_of_mem_singleton (is_wf.min_mem hs hn)

end preorder

section linear_order
variables [linear_order α] {s t : set α} {a : α}

lemma is_wf.min_le (hs : s.is_wf) (hn : s.nonempty) (ha : a ∈ s) : hs.min hn ≤ a :=
le_of_not_lt (hs.not_lt_min hn ha)

lemma is_wf.le_min_iff (hs : s.is_wf) (hn : s.nonempty) : a ≤ hs.min hn ↔ ∀ b, b ∈ s → a ≤ b :=
⟨λ ha b hb, le_trans ha (hs.min_le hn hb), λ h, h _ (hs.min_mem _)⟩

lemma is_wf.min_le_min_of_subset
  {hs : s.is_wf} {hsn : s.nonempty} {ht : t.is_wf} {htn : t.nonempty} (hst : s ⊆ t) :
  ht.min htn ≤ hs.min hsn :=
(is_wf.le_min_iff _ _).2 (λ b hb, ht.min_le htn (hst hb))

lemma is_wf.min_union (hs : s.is_wf) (hsn : s.nonempty) (ht : t.is_wf) (htn : t.nonempty) :
  (hs.union ht).min (union_nonempty.2 (or.intro_left _ hsn)) = min (hs.min hsn) (ht.min htn) :=
begin
  refine le_antisymm (le_min (is_wf.min_le_min_of_subset (subset_union_left _ _))
      (is_wf.min_le_min_of_subset (subset_union_right _ _))) _,
  rw min_le_iff,
  exact ((mem_union _ _ _).1 ((hs.union ht).min_mem
    (union_nonempty.2 (or.intro_left _ hsn)))).imp (hs.min_le _) (ht.min_le _),
end

end linear_order
end set

open set

namespace set.partially_well_ordered_on
variables {r : α → α → Prop}

/-- In the context of partial well-orderings, a bad sequence is a nonincreasing sequence
  whose range is contained in a particular set `s`. One exists if and only if `s` is not
  partially well-ordered. -/
def is_bad_seq (r : α → α → Prop) (s : set α) (f : ℕ → α) : Prop :=
(∀ n, f n ∈ s) ∧ ∀ m n : ℕ, m < n → ¬ r (f m) (f n)

lemma iff_forall_not_is_bad_seq (r : α → α → Prop) (s : set α) :
  s.partially_well_ordered_on r ↔ ∀ f, ¬ is_bad_seq r s f :=
forall_congr $ λ f, by simp [is_bad_seq]

/-- This indicates that every bad sequence `g` that agrees with `f` on the first `n`
  terms has `rk (f n) ≤ rk (g n)`. -/
def is_min_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α) (n : ℕ) (f : ℕ → α) : Prop :=
∀ g : ℕ → α, (∀ (m : ℕ), m < n → f m = g m) → rk (g n) < rk (f n) → ¬ is_bad_seq r s g

/-- Given a bad sequence `f`, this constructs a bad sequence that agrees with `f` on the first `n`
  terms and is minimal at `n`.
-/
noncomputable def min_bad_seq_of_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α)
  (n : ℕ) (f : ℕ → α) (hf : is_bad_seq r s f) :
  { g : ℕ → α // (∀ (m : ℕ), m < n → f m = g m) ∧ is_bad_seq r s g ∧ is_min_bad_seq r rk s n g } :=
begin
  classical,
  have h : ∃ (k : ℕ) (g : ℕ → α), (∀ m, m < n → f m = g m) ∧ is_bad_seq r s g
        ∧ rk (g n) = k :=
  ⟨_, f, λ _ _, rfl, hf, rfl⟩,
  obtain ⟨h1, h2, h3⟩ := classical.some_spec (nat.find_spec h),
  refine ⟨classical.some (nat.find_spec h), h1, by convert h2, λ g hg1 hg2 con, _⟩,
  refine nat.find_min h _ ⟨g, λ m mn, (h1 m mn).trans (hg1 m mn), by convert con, rfl⟩,
  rwa ← h3,
end

lemma exists_min_bad_of_exists_bad (r : α → α → Prop) (rk : α → ℕ) (s : set α) :
  (∃ f, is_bad_seq r s f) → ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rintro ⟨f0, (hf0 : is_bad_seq r s f0)⟩,
  let fs : Π (n : ℕ), { f :  ℕ → α // is_bad_seq r s f ∧ is_min_bad_seq r rk s n f },
  { refine nat.rec _ _,
    { exact ⟨(min_bad_seq_of_bad_seq r rk s 0 f0 hf0).1,
        (min_bad_seq_of_bad_seq r rk s 0 f0 hf0).2.2⟩, },
    { exact λ n fn, ⟨(min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).1,
        (min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).2.2⟩ } },
  have h : ∀ m n, m ≤ n → (fs m).1 m = (fs n).1 m,
  { intros m n mn,
    obtain ⟨k, rfl⟩ := exists_add_of_le mn,
    clear mn,
    induction k with k ih,
    { refl },
    rw [ih, ((min_bad_seq_of_bad_seq r rk s (m + k).succ (fs (m + k)).1 (fs (m + k)).2.1).2.1 m
        (nat.lt_succ_iff.2 (nat.add_le_add_left k.zero_le m)))],
    refl },
  refine ⟨λ n, (fs n).1 n, ⟨(λ n, ((fs n).2).1.1 n), λ m n mn, _⟩, λ n g hg1 hg2, _⟩,
  { dsimp,
    rw [← subtype.val_eq_coe, h m n (le_of_lt mn)],
    convert (fs n).2.1.2 m n mn },
  { convert (fs n).2.2 g (λ m mn, eq.trans _ (hg1 m mn)) (lt_of_lt_of_le hg2 le_rfl),
    rw ← h m n (le_of_lt mn) },
end

lemma iff_not_exists_is_min_bad_seq (rk : α → ℕ) {s : set α} :
  s.partially_well_ordered_on r ↔ ¬ ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rw [iff_forall_not_is_bad_seq, ← not_exists, not_congr],
  split,
  { apply exists_min_bad_of_exists_bad },
  rintro ⟨f, hf1, hf2⟩,
  exact ⟨f, hf1⟩,
end

/-- Higman's Lemma, which states that for any reflexive, transitive relation `r` which is
  partially well-ordered on a set `s`, the relation `list.sublist_forall₂ r` is partially
  well-ordered on the set of lists of elements of `s`. That relation is defined so that
  `list.sublist_forall₂ r l₁ l₂` whenever `l₁` related pointwise by `r` to a sublist of `l₂`.  -/
lemma partially_well_ordered_on_sublist_forall₂ (r : α → α → Prop) [is_refl α r] [is_trans α r]
  {s : set α} (h : s.partially_well_ordered_on r) :
  { l : list α | ∀ x, x ∈ l → x ∈ s }.partially_well_ordered_on (list.sublist_forall₂ r) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨as, has⟩,
  { apply partially_well_ordered_on.mono (finset.partially_well_ordered_on {list.nil}),
    { intros l hl,
      rw [finset.mem_coe, finset.mem_singleton, list.eq_nil_iff_forall_not_mem],
      exact hl, },
    apply_instance },
  haveI : inhabited α := ⟨as⟩,
  rw [iff_not_exists_is_min_bad_seq (list.length)],
  rintro ⟨f, hf1, hf2⟩,
  have hnil : ∀ n, f n ≠ list.nil :=
    λ n con, (hf1).2 n n.succ n.lt_succ_self (con.symm ▸ list.sublist_forall₂.nil),
  obtain ⟨g, hg⟩ := h.exists_monotone_subseq (list.head ∘ f) _,
  swap, { simp only [set.range_subset_iff, function.comp_apply],
    exact λ n, hf1.1 n _ (list.head_mem_self (hnil n)) },
  have hf' := hf2 (g 0) (λ n, if n < g 0 then f n else list.tail (f (g (n - g 0))))
    (λ m hm, (if_pos hm).symm) _,
  swap, { simp only [if_neg (lt_irrefl (g 0)), tsub_self],
    rw [list.length_tail, ← nat.pred_eq_sub_one],
    exact nat.pred_lt (λ con, hnil _ (list.length_eq_zero.1 con)) },
  rw [is_bad_seq] at hf',
  push_neg at hf',
  obtain ⟨m, n, mn, hmn⟩ := hf' _,
  swap,
  { rintro n x hx,
    split_ifs at hx with hn hn,
    { exact hf1.1 _ _ hx },
    { refine hf1.1 _ _ (list.tail_subset _ hx), } },
  by_cases hn : n < g 0,
  { apply hf1.2 m n mn,
    rwa [if_pos hn, if_pos (mn.trans hn)] at hmn },
  { obtain ⟨n', rfl⟩ := exists_add_of_le (not_lt.1 hn),
    rw [if_neg hn, add_comm (g 0) n', add_tsub_cancel_right] at hmn,
    split_ifs at hmn with hm hm,
    { apply hf1.2 m (g n') (lt_of_lt_of_le hm (g.monotone n'.zero_le)),
      exact trans hmn (list.tail_sublist_forall₂_self _) },
    { rw [← (tsub_lt_iff_left (le_of_not_lt hm))] at mn,
      apply hf1.2 _ _ (g.lt_iff_lt.2 mn),
      rw [← list.cons_head_tail (hnil (g (m - g 0))), ← list.cons_head_tail (hnil (g n'))],
      exact list.sublist_forall₂.cons (hg _ _ (le_of_lt mn)) hmn, } }
end

end set.partially_well_ordered_on

lemma well_founded.is_wf [has_lt α] (h : well_founded ((<) : α → α → Prop)) (s : set α) : s.is_wf :=
(set.is_wf_univ_iff.2 h).mono s.subset_univ

/-- A version of **Dickson's lemma** any subset of functions `Π s : σ, α s` is partially well
ordered, when `σ` is a `fintype` and each `α s` is a linear well order.
This includes the classical case of Dickson's lemma that `ℕ ^ n` is a well partial order.
Some generalizations would be possible based on this proof, to include cases where the target is
partially well ordered, and also to consider the case of `set.partially_well_ordered_on` instead of
`set.is_pwo`. -/
lemma pi.is_pwo {α : ι → Type*} [Π i, linear_order (α i)] [∀ i, is_well_order (α i) (<)] [finite ι]
  (s : set (Π i, α i)) : s.is_pwo :=
begin
  casesI nonempty_fintype ι,
  suffices : ∀ s : finset ι, ∀ (f : ℕ → Π s, α s), ∃ g : ℕ ↪o ℕ,
    ∀ ⦃a b : ℕ⦄, a ≤ b → ∀ (x : ι) (hs : x ∈ s), (f ∘ g) a x ≤ (f ∘ g) b x,
  { refine is_pwo_iff_exists_monotone_subseq.2 (λ f hf, _),
    simpa only [finset.mem_univ, true_implies_iff] using this finset.univ f },
  refine finset.cons_induction _ _,
  { intros f, existsi rel_embedding.refl (≤),
    simp only [is_empty.forall_iff, implies_true_iff, forall_const, finset.not_mem_empty], },
  { intros x s hx ih f,
    obtain ⟨g, hg⟩ := (is_well_founded.wf.is_wf univ).is_pwo.exists_monotone_subseq (λ n, f n x)
      mem_univ,
    obtain ⟨g', hg'⟩ := ih (f ∘ g),
    refine ⟨g'.trans g, λ a b hab, (finset.forall_mem_cons _ _).2 _⟩,
    exact ⟨hg (order_hom_class.mono g' hab), hg' hab⟩ }
end


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.cancel.defs
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Monoid.Defs

/-!
# Ordered cancellative monoids
-/

universe u

variable {α : Type u}

open Function

/-- An ordered cancellative additive commutative monoid
is an additive commutative monoid with a partial order,
in which addition is cancellative and monotone. -/
class OrderedCancelAddCommMonoid (α : Type u) extends AddCommMonoid α, PartialOrder α where
  /-- Addition is monotone in an ordered cancellative additive commutative monoid. -/
  protected add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b
  /-- Additive cancellation is compatible with the order in an ordered cancellative additive
    commutative monoid. -/
  protected le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c
#align ordered_cancel_add_comm_monoid OrderedCancelAddCommMonoid

/-- An ordered cancellative commutative monoid
is a commutative monoid with a partial order,
in which multiplication is cancellative and monotone. -/
class OrderedCancelCommMonoid (α : Type u) extends CommMonoid α, PartialOrder α where
  /-- Multiplication is monotone in an ordered cancellative commutative monoid. -/
  protected mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b
  /-- Cancellation is compatible with the order in an ordered cancellative commutative monoid. -/
  protected le_of_mul_le_mul_left : ∀ a b c : α, a * b ≤ a * c → b ≤ c
#align ordered_cancel_comm_monoid OrderedCancelCommMonoid

attribute [to_additive OrderedCancelAddCommMonoid] OrderedCancelCommMonoid

section OrderedCancelCommMonoid

variable [OrderedCancelCommMonoid α] {a b c d : α}

-- see Note [lower instance priority]
@[to_additive]
instance (priority := 200) OrderedCancelCommMonoid.to_contravariantClass_le_left :
    ContravariantClass α α (· * ·) (· ≤ ·) :=
  ⟨OrderedCancelCommMonoid.le_of_mul_le_mul_left⟩
#align ordered_cancel_comm_monoid.to_contravariant_class_le_left OrderedCancelCommMonoid.to_contravariantClass_le_left
#align ordered_cancel_add_comm_monoid.to_contravariant_class_le_left OrderedCancelAddCommMonoid.to_contravariantClass_le_left

@[to_additive]
theorem OrderedCancelCommMonoid.lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c :=
  fun a b c h =>
  lt_of_le_not_le (OrderedCancelCommMonoid.le_of_mul_le_mul_left a b c h.le) <|
    mt (fun h => OrderedCancelCommMonoid.mul_le_mul_left _ _ h _) (not_le_of_gt h)
#align ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left OrderedCancelCommMonoid.lt_of_mul_lt_mul_left
#align ordered_cancel_add_comm_monoid.lt_of_add_lt_add_left OrderedCancelAddCommMonoid.lt_of_add_lt_add_left

@[to_additive]
instance OrderedCancelCommMonoid.to_contravariantClass_left (M : Type _)
    [OrderedCancelCommMonoid M] :
    ContravariantClass M M (· * ·) (· < ·) where
  elim _ _ _ := OrderedCancelCommMonoid.lt_of_mul_lt_mul_left _ _ _
#align ordered_cancel_comm_monoid.to_contravariant_class_left OrderedCancelCommMonoid.to_contravariantClass_left
#align ordered_cancel_add_comm_monoid.to_contravariant_class_left OrderedCancelAddCommMonoid.to_contravariantClass_left

/- This instance can be proven with `by apply_instance`.  However, by analogy with the
instance `OrderedCancelCommMonoid.to_covariantClass_right` above, I imagine that without
this instance, some Type would not have a `ContravariantClass M M (function.swap (*)) (<)`
instance. -/
@[to_additive]
instance OrderedCancelCommMonoid.to_contravariantClass_right (M : Type _)
    [OrderedCancelCommMonoid M] :
    ContravariantClass M M (swap (· * ·)) (· < ·) :=
  contravariant_swap_mul_lt_of_contravariant_mul_lt M
#align ordered_cancel_comm_monoid.to_contravariant_class_right OrderedCancelCommMonoid.to_contravariantClass_right
#align ordered_cancel_add_comm_monoid.to_contravariant_class_right OrderedCancelAddCommMonoid.to_contravariantClass_right

-- see Note [lower instance priority]
@[to_additive]
instance (priority := 100) OrderedCancelCommMonoid.toOrderedCommMonoid : OrderedCommMonoid α :=
  { ‹OrderedCancelCommMonoid α› with }
#align ordered_cancel_comm_monoid.to_ordered_comm_monoid OrderedCancelCommMonoid.toOrderedCommMonoid
#align ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid OrderedCancelAddCommMonoid.toOrderedAddCommMonoid

-- see Note [lower instance priority]
@[to_additive OrderedCancelAddCommMonoid.toCancelAddCommMonoid]
instance (priority := 100) OrderedCancelCommMonoid.toCancelCommMonoid : CancelCommMonoid α :=
  { ‹OrderedCancelCommMonoid α› with
    mul_left_cancel :=
      fun a b c h => (le_of_mul_le_mul_left' h.le).antisymm <| le_of_mul_le_mul_left' h.ge }
#align ordered_cancel_comm_monoid.to_cancel_comm_monoid OrderedCancelCommMonoid.toCancelCommMonoid
#align ordered_cancel_add_comm_monoid.to_cancel_add_comm_monoid OrderedCancelAddCommMonoid.toCancelAddCommMonoid

end OrderedCancelCommMonoid

/-- A linearly ordered cancellative additive commutative monoid
is an additive commutative monoid with a decidable linear order
in which addition is cancellative and monotone. -/
class LinearOrderedCancelAddCommMonoid (α : Type u) extends OrderedCancelAddCommMonoid α,
    LinearOrderedAddCommMonoid α
#align linear_ordered_cancel_add_comm_monoid LinearOrderedCancelAddCommMonoid

/-- A linearly ordered cancellative commutative monoid
is a commutative monoid with a linear order
in which multiplication is cancellative and monotone. -/
class LinearOrderedCancelCommMonoid (α : Type u) extends OrderedCancelCommMonoid α,
    LinearOrderedCommMonoid α
#align linear_ordered_cancel_comm_monoid LinearOrderedCancelCommMonoid

attribute [to_additive LinearOrderedCancelAddCommMonoid] LinearOrderedCancelCommMonoid
attribute [to_additive existing] LinearOrderedCancelCommMonoid.toLinearOrderedCommMonoid