/-
Copyright (c) 2019 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, François Dupuis
-/
import analysis.convex.basic
import tactic.field_simp
import tactic.linarith
import tactic.ring

/-!
# Convex and concave functions

This file defines convex and concave functions in vector spaces and proves the finite Jensen
inequality. The integral version can be found in `analysis.convex.integral`.

A function `f : E → β` is `convex_on` a set `s` if `s` is itself a convex set, and for any two
points `x y ∈ s`, the segment joining `(x, f x)` to `(y, f y)` is above the graph of `f`.
Equivalently, `convex_on 𝕜 f s` means that the epigraph `{p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2}` is
a convex set.

## Main declarations

* `convex_on 𝕜 s f`: The function `f` is convex on `s` with scalars `𝕜`.
* `concave_on 𝕜 s f`: The function `f` is concave on `s` with scalars `𝕜`.
* `strict_convex_on 𝕜 s f`: The function `f` is strictly convex on `s` with scalars `𝕜`.
* `strict_concave_on 𝕜 s f`: The function `f` is strictly concave on `s` with scalars `𝕜`.
-/

open finset linear_map set
open_locale big_operators classical convex pointwise

variables {𝕜 E F β ι : Type*}

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid β]

section has_scalar
variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 β] (s : set E) (f : E → β)

/-- Convexity of functions -/
def convex_on : Prop :=
convex 𝕜 s ∧
  ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
    f (a • x + b • y) ≤ a • f x + b • f y

/-- Concavity of functions -/
def concave_on : Prop :=
convex 𝕜 s ∧
  ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
    a • f x + b • f y ≤ f (a • x + b • y)

/-- Strict convexity of functions -/
def strict_convex_on : Prop :=
convex 𝕜 s ∧
  ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
    f (a • x + b • y) < a • f x + b • f y

/-- Strict concavity of functions -/
def strict_concave_on : Prop :=
convex 𝕜 s ∧
  ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
    a • f x + b • f y < f (a • x + b • y)

variables {𝕜 s f}

open order_dual (to_dual of_dual)

lemma convex_on.dual (hf : convex_on 𝕜 s f) : concave_on 𝕜 s (to_dual ∘ f) := hf

lemma concave_on.dual (hf : concave_on 𝕜 s f) : convex_on 𝕜 s (to_dual ∘ f) := hf

lemma strict_convex_on.dual (hf : strict_convex_on 𝕜 s f) : strict_concave_on 𝕜 s (to_dual ∘ f) :=
hf

lemma strict_concave_on.dual (hf : strict_concave_on 𝕜 s f) : strict_convex_on 𝕜 s (to_dual ∘ f) :=
hf

lemma convex_on_id {s : set β} (hs : convex 𝕜 s) : convex_on 𝕜 s id := ⟨hs, by { intros, refl }⟩

lemma concave_on_id {s : set β} (hs : convex 𝕜 s) : concave_on 𝕜 s id := ⟨hs, by { intros, refl }⟩

lemma convex_on.subset {t : set E} (hf : convex_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) :
  convex_on 𝕜 s f :=
⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩

lemma concave_on.subset {t : set E} (hf : concave_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) :
  concave_on 𝕜 s f :=
⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩

lemma strict_convex_on.subset {t : set E} (hf : strict_convex_on 𝕜 t f) (hst : s ⊆ t)
  (hs : convex 𝕜 s) :
  strict_convex_on 𝕜 s f :=
⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩

lemma strict_concave_on.subset {t : set E} (hf : strict_concave_on 𝕜 t f) (hst : s ⊆ t)
  (hs : convex 𝕜 s) :
  strict_concave_on 𝕜 s f :=
⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩

end has_scalar

section distrib_mul_action
variables [has_scalar 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β}

lemma convex_on.add (hf : convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) :
  convex_on 𝕜 s (f + g) :=
⟨hf.1, λ x y hx hy a b ha hb hab,
  calc
    f (a • x + b • y) + g (a • x + b • y) ≤ (a • f x + b • f y) + (a • g x + b • g y)
      : add_le_add (hf.2 hx hy ha hb hab) (hg.2 hx hy ha hb hab)
    ... = a • (f x + g x) + b • (f y + g y) : by rw [smul_add, smul_add, add_add_add_comm]⟩

lemma concave_on.add (hf : concave_on 𝕜 s f) (hg : concave_on 𝕜 s g) :
  concave_on 𝕜 s (f + g) :=
hf.dual.add hg

end distrib_mul_action

section module
variables [has_scalar 𝕜 E] [module 𝕜 β] {s : set E} {f : E → β}

lemma convex_on_const (c : β) (hs : convex 𝕜 s) : convex_on 𝕜 s (λ x:E, c) :=
⟨hs, λ x y _ _ a b _ _ hab, (convex.combo_self hab c).ge⟩

lemma concave_on_const (c : β) (hs : convex 𝕜 s) : concave_on 𝕜 s (λ x:E, c) :=
@convex_on_const _ _ βᵒᵈ _ _ _ _ _ _ c hs

lemma convex_on_of_convex_epigraph (h : convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2}) :
  convex_on 𝕜 s f :=
⟨λ x y hx hy a b ha hb hab, (@h (x, f x) (y, f y) ⟨hx, le_rfl⟩ ⟨hy, le_rfl⟩ a b ha hb hab).1,
  λ x y hx hy a b ha hb hab, (@h (x, f x) (y, f y) ⟨hx, le_rfl⟩ ⟨hy, le_rfl⟩ a b ha hb hab).2⟩

lemma concave_on_of_convex_hypograph (h : convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1}) :
  concave_on 𝕜 s f :=
@convex_on_of_convex_epigraph 𝕜  E βᵒᵈ _ _ _ _ _ _ _ h

end module

section ordered_smul
variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.convex_le (hf : convex_on 𝕜 s f) (r : β) :
  convex 𝕜 {x ∈ s | f x ≤ r} :=
λ x y hx hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha hb hab,
  calc
    f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx.1 hy.1 ha hb hab
                  ... ≤ a • r + b • r     : add_le_add (smul_le_smul_of_nonneg hx.2 ha)
                                              (smul_le_smul_of_nonneg hy.2 hb)
                  ... = r                 : convex.combo_self hab r⟩

lemma concave_on.convex_ge (hf : concave_on 𝕜 s f) (r : β) :
  convex 𝕜 {x ∈ s | r ≤ f x} :=
hf.dual.convex_le r

lemma convex_on.convex_epigraph (hf : convex_on 𝕜 s f) :
  convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2} :=
begin
  rintro ⟨x, r⟩ ⟨y, t⟩ ⟨hx, hr⟩ ⟨hy, ht⟩ a b ha hb hab,
  refine ⟨hf.1 hx hy ha hb hab, _⟩,
  calc f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx hy ha hb hab
  ... ≤ a • r + b • t : add_le_add (smul_le_smul_of_nonneg hr ha)
                            (smul_le_smul_of_nonneg ht hb)
end

lemma concave_on.convex_hypograph (hf : concave_on 𝕜 s f) :
  convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1} :=
hf.dual.convex_epigraph

lemma convex_on_iff_convex_epigraph :
  convex_on 𝕜 s f ↔ convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2} :=
⟨convex_on.convex_epigraph, convex_on_of_convex_epigraph⟩

lemma concave_on_iff_convex_hypograph :
  concave_on 𝕜 s f ↔ convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1} :=
@convex_on_iff_convex_epigraph 𝕜 E βᵒᵈ _ _ _ _ _ _ _ f

end ordered_smul

section module
variables [module 𝕜 E] [has_scalar 𝕜 β] {s : set E} {f : E → β}

/-- Right translation preserves convexity. -/
lemma convex_on.translate_right (hf : convex_on 𝕜 s f) (c : E) :
  convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) :=
⟨hf.1.translate_preimage_right _, λ x y hx hy a b ha hb hab,
  calc
    f (c + (a • x + b • y)) = f (a • (c + x) + b • (c + y))
        : by rw [smul_add, smul_add, add_add_add_comm, convex.combo_self hab]
    ... ≤ a • f (c + x) + b • f (c + y) : hf.2 hx hy ha hb hab⟩

/-- Right translation preserves concavity. -/
lemma concave_on.translate_right (hf : concave_on 𝕜 s f) (c : E) :
  concave_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) :=
hf.dual.translate_right _

/-- Left translation preserves convexity. -/
lemma convex_on.translate_left (hf : convex_on 𝕜 s f) (c : E) :
  convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, z + c)) :=
by simpa only [add_comm] using hf.translate_right _

/-- Left translation preserves concavity. -/
lemma concave_on.translate_left (hf : concave_on 𝕜 s f) (c : E) :
  concave_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, z + c)) :=
hf.dual.translate_left _

end module

section module
variables [module 𝕜 E] [module 𝕜 β]

lemma convex_on_iff_forall_pos {s : set E} {f : E → β} :
  convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1
    → f (a • x + b • y) ≤ a • f x + b • f y :=
begin
  refine and_congr_right' ⟨λ h x y hx hy a b ha hb hab, h hx hy ha.le hb.le hab,
    λ h x y hx hy a b ha hb hab, _⟩,
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_add] at hab, subst b, simp_rw [zero_smul, zero_add, one_smul] },
  obtain rfl | hb' := hb.eq_or_lt,
  { rw [add_zero] at hab, subst a, simp_rw [zero_smul, add_zero, one_smul] },
  exact h hx hy ha' hb' hab,
end

lemma concave_on_iff_forall_pos {s : set E} {f : E → β} :
  concave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1
    → a • f x + b • f y ≤ f (a • x + b • y) :=
@convex_on_iff_forall_pos 𝕜 E βᵒᵈ _ _ _ _ _ _ _

lemma convex_on_iff_pairwise_pos {s : set E} {f : E → β} :
  convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    s.pairwise (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1
    → f (a • x + b • y) ≤ a • f x + b • f y) :=
begin
  rw convex_on_iff_forall_pos,
  refine and_congr_right' ⟨λ h x hx y hy _ a b ha hb hab, h hx hy ha hb hab,
    λ h x y hx hy a b ha hb hab, _⟩,
  obtain rfl | hxy := eq_or_ne x y,
  { rw [convex.combo_self hab, convex.combo_self hab] },
  exact h hx hy hxy ha hb hab,
end

lemma concave_on_iff_pairwise_pos {s : set E} {f : E → β} :
  concave_on 𝕜 s f ↔ convex 𝕜 s ∧
   s.pairwise (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1
    → a • f x + b • f y ≤ f (a • x + b • y)) :=
@convex_on_iff_pairwise_pos 𝕜 E βᵒᵈ _ _ _ _ _ _ _

/-- A linear map is convex. -/
lemma linear_map.convex_on (f : E →ₗ[𝕜] β) {s : set E} (hs : convex 𝕜 s) : convex_on 𝕜 s f :=
⟨hs, λ _ _ _ _ _ _ _ _ _, by rw [f.map_add, f.map_smul, f.map_smul]⟩

/-- A linear map is concave. -/
lemma linear_map.concave_on (f : E →ₗ[𝕜] β) {s : set E} (hs : convex 𝕜 s) : concave_on 𝕜 s f :=
⟨hs, λ _ _ _ _ _ _ _ _ _, by rw [f.map_add, f.map_smul, f.map_smul]⟩

lemma strict_convex_on.convex_on {s : set E} {f : E → β} (hf : strict_convex_on 𝕜 s f) :
  convex_on 𝕜 s f :=
convex_on_iff_pairwise_pos.mpr ⟨hf.1, λ x hx y hy hxy a b ha hb hab, (hf.2 hx hy hxy ha hb hab).le⟩

lemma strict_concave_on.concave_on {s : set E} {f : E → β} (hf : strict_concave_on 𝕜 s f) :
  concave_on 𝕜 s f :=
hf.dual.convex_on

section ordered_smul
variables [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma strict_convex_on.convex_lt (hf : strict_convex_on 𝕜 s f) (r : β) :
  convex 𝕜 {x ∈ s | f x < r} :=
convex_iff_pairwise_pos.2 $ λ x hx y hy hxy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha.le hb.le hab,
  calc
    f (a • x + b • y) < a • f x + b • f y : hf.2 hx.1 hy.1 hxy ha hb hab
                  ... ≤ a • r + b • r     : add_le_add (smul_lt_smul_of_pos hx.2 ha).le
                                              (smul_lt_smul_of_pos hy.2 hb).le
                  ... = r                 : convex.combo_self hab r⟩

lemma strict_concave_on.convex_gt (hf : strict_concave_on 𝕜 s f) (r : β) :
  convex 𝕜 {x ∈ s | r < f x} :=
hf.dual.convex_lt r

end ordered_smul

section linear_order
variables [linear_order E] {s : set E} {f : E → β}

/-- For a function on a convex set in a linearly ordered space (where the order and the algebraic
structures aren't necessarily compatible), in order to prove that it is convex, it suffices to
verify the inequality `f (a • x + b • y) ≤ a • f x + b • f y` only for `x < y` and positive `a`,
`b`. The main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order.
-/
lemma linear_order.convex_on_of_lt (hs : convex 𝕜 s)
  (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
    f (a • x + b • y) ≤ a • f x + b • f y) : convex_on 𝕜 s f :=
begin
  refine convex_on_iff_pairwise_pos.2 ⟨hs, λ x hx y hy hxy a b ha hb hab, _⟩,
  wlog h : x ≤ y using [x y a b, y x b a],
  { exact le_total _ _ },
  exact hf hx hy (h.lt_of_ne hxy) ha hb hab,
end

/-- For a function on a convex set in a linearly ordered space (where the order and the algebraic
structures aren't necessarily compatible), in order to prove that it is concave it suffices to
verify the inequality `a • f x + b • f y ≤ f (a • x + b • y)` for `x < y` and positive `a`, `b`. The
main use case is `E = ℝ` however one can apply it, e.g., to `ℝ^n` with lexicographic order. -/
lemma linear_order.concave_on_of_lt (hs : convex 𝕜 s)
  (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
     a • f x + b • f y ≤ f (a • x + b • y)) : concave_on 𝕜 s f :=
@linear_order.convex_on_of_lt _ _ βᵒᵈ _ _ _ _ _ _ s f hs hf

/-- For a function on a convex set in a linearly ordered space (where the order and the algebraic
structures aren't necessarily compatible), in order to prove that it is convex, it suffices to
verify the inequality `f (a • x + b • y) ≤ a • f x + b • f y` for `x < y` and positive `a`, `b`. The
main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/
lemma linear_order.strict_convex_on_of_lt (hs : convex 𝕜 s)
  (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
    f (a • x + b • y) < a • f x + b • f y) : strict_convex_on 𝕜 s f :=
begin
  refine ⟨hs, λ x y hx hy hxy a b ha hb hab, _⟩,
  wlog h : x ≤ y using [x y a b, y x b a],
  { exact le_total _ _ },
  exact hf hx hy (h.lt_of_ne hxy) ha hb hab,
end

/-- For a function on a convex set in a linearly ordered space (where the order and the algebraic
structures aren't necessarily compatible), in order to prove that it is concave it suffices to
verify the inequality `a • f x + b • f y ≤ f (a • x + b • y)` for `x < y` and positive `a`, `b`. The
main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/
lemma linear_order.strict_concave_on_of_lt (hs : convex 𝕜 s)
  (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 →
     a • f x + b • f y < f (a • x + b • y)) : strict_concave_on 𝕜 s f :=
@linear_order.strict_convex_on_of_lt _ _ βᵒᵈ _ _ _ _ _ _ _ _ hs hf

end linear_order
end module

section module
variables [module 𝕜 E] [module 𝕜 F] [has_scalar 𝕜 β]

/-- If `g` is convex on `s`, so is `(f ∘ g)` on `f ⁻¹' s` for a linear `f`. -/
lemma convex_on.comp_linear_map {f : F → β} {s : set F} (hf : convex_on 𝕜 s f) (g : E →ₗ[𝕜] F) :
  convex_on 𝕜 (g ⁻¹' s) (f ∘ g) :=
⟨hf.1.linear_preimage _, λ x y hx hy a b ha hb hab,
  calc
    f (g (a • x + b • y)) = f (a • (g x) + b • (g y)) : by rw [g.map_add, g.map_smul, g.map_smul]
                      ... ≤ a • f (g x) + b • f (g y) : hf.2 hx hy ha hb hab⟩

/-- If `g` is concave on `s`, so is `(g ∘ f)` on `f ⁻¹' s` for a linear `f`. -/
lemma concave_on.comp_linear_map {f : F → β} {s : set F} (hf : concave_on 𝕜 s f) (g : E →ₗ[𝕜] F) :
  concave_on 𝕜 (g ⁻¹' s) (f ∘ g) :=
hf.dual.comp_linear_map g

end module
end ordered_add_comm_monoid

section ordered_cancel_add_comm_monoid
variables [ordered_cancel_add_comm_monoid β]

section distrib_mul_action
variables [has_scalar 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β}

lemma strict_convex_on.add_convex_on (hf : strict_convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f + g) :=
⟨hf.1, λ x y hx hy hxy a b ha hb hab,
  calc
    f (a • x + b • y) + g (a • x + b • y) < (a • f x + b • f y) + (a • g x + b • g y)
      : add_lt_add_of_lt_of_le (hf.2 hx hy hxy ha hb hab) (hg.2 hx hy ha.le hb.le hab)
    ... = a • (f x + g x) + b • (f y + g y) : by rw [smul_add, smul_add, add_add_add_comm]⟩

lemma convex_on.add_strict_convex_on (hf : convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f + g) :=
(add_comm g f) ▸ hg.add_convex_on hf

lemma strict_convex_on.add (hf : strict_convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f + g) :=
⟨hf.1, λ x y hx hy hxy a b ha hb hab,
  calc
    f (a • x + b • y) + g (a • x + b • y) < (a • f x + b • f y) + (a • g x + b • g y)
      : add_lt_add (hf.2 hx hy hxy ha hb hab) (hg.2 hx hy hxy ha hb hab)
    ... = a • (f x + g x) + b • (f y + g y) : by rw [smul_add, smul_add, add_add_add_comm]⟩

lemma strict_concave_on.add_concave_on (hf : strict_concave_on 𝕜 s f) (hg : concave_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f + g) :=
hf.dual.add_convex_on hg.dual

lemma concave_on.add_strict_concave_on (hf : concave_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f + g) :=
hf.dual.add_strict_convex_on hg.dual

lemma strict_concave_on.add (hf : strict_concave_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f + g) :=
hf.dual.add hg

end distrib_mul_action

section module
variables [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.convex_lt (hf : convex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} :=
convex_iff_forall_pos.2 $ λ x y hx hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha.le hb.le hab,
  calc
    f (a • x + b • y)
        ≤ a • f x + b • f y : hf.2 hx.1 hy.1 ha.le hb.le hab
    ... < a • r + b • r     : add_lt_add_of_lt_of_le (smul_lt_smul_of_pos hx.2 ha)
                                (smul_le_smul_of_nonneg hy.2.le hb.le)
    ... = r                 : convex.combo_self hab _⟩

lemma concave_on.convex_gt (hf : concave_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | r < f x} :=
hf.dual.convex_lt r

lemma convex_on.open_segment_subset_strict_epigraph (hf : convex_on 𝕜 s f) (p q : E × β)
  (hp : p.1 ∈ s ∧ f p.1 < p.2) (hq : q.1 ∈ s ∧ f q.1 ≤ q.2) :
  open_segment 𝕜 p q ⊆ {p : E × β | p.1 ∈ s ∧ f p.1 < p.2} :=
begin
  rintro _ ⟨a, b, ha, hb, hab, rfl⟩,
  refine ⟨hf.1 hp.1 hq.1 ha.le hb.le hab, _⟩,
  calc f (a • p.1 + b • q.1) ≤ a • f p.1 + b • f q.1 : hf.2 hp.1 hq.1 ha.le hb.le hab
  ... < a • p.2 + b • q.2 :
    add_lt_add_of_lt_of_le (smul_lt_smul_of_pos hp.2 ha) (smul_le_smul_of_nonneg hq.2 hb.le)
end

lemma concave_on.open_segment_subset_strict_hypograph (hf : concave_on 𝕜 s f) (p q : E × β)
  (hp : p.1 ∈ s ∧ p.2 < f p.1) (hq : q.1 ∈ s ∧ q.2 ≤ f q.1) :
  open_segment 𝕜 p q ⊆ {p : E × β | p.1 ∈ s ∧ p.2 < f p.1} :=
hf.dual.open_segment_subset_strict_epigraph p q hp hq

lemma convex_on.convex_strict_epigraph (hf : convex_on 𝕜 s f) :
  convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 < p.2} :=
convex_iff_open_segment_subset.mpr $
  λ p q hp hq, hf.open_segment_subset_strict_epigraph p q hp ⟨hq.1, hq.2.le⟩

lemma concave_on.convex_strict_hypograph (hf : concave_on 𝕜 s f) :
  convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 < f p.1} :=
hf.dual.convex_strict_epigraph

end module
end ordered_cancel_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid β] [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β]
  {s : set E} {f g : E → β}

/-- The pointwise maximum of convex functions is convex. -/
lemma convex_on.sup (hf : convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) :
  convex_on 𝕜 s (f ⊔ g) :=
begin
  refine ⟨hf.left, λ x y hx hy a b ha hb hab, sup_le _ _⟩,
  { calc f (a • x + b • y) ≤ a • f x + b • f y : hf.right hx hy ha hb hab
     ...                   ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add
     (smul_le_smul_of_nonneg le_sup_left ha)
     (smul_le_smul_of_nonneg le_sup_left hb) },
  { calc g (a • x + b • y) ≤ a • g x + b • g y : hg.right hx hy ha hb hab
     ...                   ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add
     (smul_le_smul_of_nonneg le_sup_right ha)
     (smul_le_smul_of_nonneg le_sup_right hb) }
end

/-- The pointwise minimum of concave functions is concave. -/
lemma concave_on.inf (hf : concave_on 𝕜 s f) (hg : concave_on 𝕜 s g) :
  concave_on 𝕜 s (f ⊓ g) :=
hf.dual.sup hg

/-- The pointwise maximum of strictly convex functions is strictly convex. -/
lemma strict_convex_on.sup (hf : strict_convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f ⊔ g) :=
⟨hf.left, λ x y hx hy hxy a b ha hb hab, max_lt
  (calc f (a • x + b • y) < a • f x + b • f y : hf.2 hx hy hxy ha hb hab
    ...                   ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add
    (smul_le_smul_of_nonneg le_sup_left ha.le)
    (smul_le_smul_of_nonneg le_sup_left hb.le))
  (calc g (a • x + b • y) < a • g x + b • g y : hg.2 hx hy hxy ha hb hab
    ...                   ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add
    (smul_le_smul_of_nonneg le_sup_right ha.le)
    (smul_le_smul_of_nonneg le_sup_right hb.le))⟩

/-- The pointwise minimum of strictly concave functions is strictly concave. -/
lemma strict_concave_on.inf (hf : strict_concave_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) :
   strict_concave_on 𝕜 s (f ⊓ g) :=
hf.dual.sup hg

/-- A convex function on a segment is upper-bounded by the max of its endpoints. -/
lemma convex_on.le_on_segment' (hf : convex_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s)
  {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  f (a • x + b • y) ≤ max (f x) (f y) :=
calc
  f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx hy ha hb hab
  ... ≤ a • max (f x) (f y) + b • max (f x) (f y) :
    add_le_add (smul_le_smul_of_nonneg (le_max_left _ _) ha)
      (smul_le_smul_of_nonneg (le_max_right _ _) hb)
  ... = max (f x) (f y) : convex.combo_self hab _

/-- A concave function on a segment is lower-bounded by the min of its endpoints. -/
lemma concave_on.ge_on_segment' (hf : concave_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s)
  {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  min (f x) (f y) ≤ f (a • x + b • y) :=
hf.dual.le_on_segment' hx hy ha hb hab

/-- A convex function on a segment is upper-bounded by the max of its endpoints. -/
lemma convex_on.le_on_segment (hf : convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
  (hz : z ∈ [x -[𝕜] y]) :
  f z ≤ max (f x) (f y) :=
let ⟨a, b, ha, hb, hab, hz⟩ := hz in hz ▸ hf.le_on_segment' hx hy ha hb hab

/-- A concave function on a segment is lower-bounded by the min of its endpoints. -/
lemma concave_on.ge_on_segment (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
  (hz : z ∈ [x -[𝕜] y]) :
  min (f x) (f y) ≤ f z :=
hf.dual.le_on_segment hx hy hz

/-- A strictly convex function on an open segment is strictly upper-bounded by the max of its
endpoints. -/
lemma strict_convex_on.lt_on_open_segment' (hf : strict_convex_on 𝕜 s f) {x y : E} (hx : x ∈ s)
  (hy : y ∈ s) (hxy : x ≠ y) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) :
  f (a • x + b • y) < max (f x) (f y) :=
calc
  f (a • x + b • y) < a • f x + b • f y : hf.2 hx hy hxy ha hb hab
  ... ≤ a • max (f x) (f y) + b • max (f x) (f y) :
    add_le_add (smul_le_smul_of_nonneg (le_max_left _ _) ha.le)
      (smul_le_smul_of_nonneg (le_max_right _ _) hb.le)
  ... = max (f x) (f y) : convex.combo_self hab _

/-- A strictly concave function on an open segment is strictly lower-bounded by the min of its
endpoints. -/
lemma strict_concave_on.lt_on_open_segment' (hf : strict_concave_on 𝕜 s f) {x y : E} (hx : x ∈ s)
  (hy : y ∈ s) (hxy : x ≠ y) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) :
  min (f x) (f y) < f (a • x + b • y) :=
hf.dual.lt_on_open_segment' hx hy hxy ha hb hab

/-- A strictly convex function on an open segment is strictly upper-bounded by the max of its
endpoints. -/
lemma strict_convex_on.lt_on_open_segment (hf : strict_convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hxy : x ≠ y) (hz : z ∈ open_segment 𝕜 x y) :
  f z < max (f x) (f y) :=
let ⟨a, b, ha, hb, hab, hz⟩ := hz in hz ▸ hf.lt_on_open_segment' hx hy hxy ha hb hab

/-- A strictly concave function on an open segment is strictly lower-bounded by the min of its
endpoints. -/
lemma strict_concave_on.lt_on_open_segment (hf : strict_concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hxy : x ≠ y) (hz : z ∈ open_segment 𝕜 x y) :
  min (f x) (f y) < f z :=
hf.dual.lt_on_open_segment hx hy hxy hz

end linear_ordered_add_comm_monoid

section linear_ordered_cancel_add_comm_monoid
variables [linear_ordered_cancel_add_comm_monoid β]

section ordered_smul
variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f g : E → β}

lemma convex_on.le_left_of_right_le' (hf : convex_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s)
  {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) (hfy : f y ≤ f (a • x + b • y)) :
  f (a • x + b • y) ≤ f x :=
le_of_not_lt $ λ h, lt_irrefl (f (a • x + b • y)) $
  calc
    f (a • x + b • y)
        ≤ a • f x + b • f y : hf.2 hx hy ha.le hb hab
    ... < a • f (a • x + b • y) + b • f (a • x + b • y)
        : add_lt_add_of_lt_of_le (smul_lt_smul_of_pos h ha) (smul_le_smul_of_nonneg hfy hb)
    ... = f (a • x + b • y) : convex.combo_self hab _

lemma concave_on.left_le_of_le_right' (hf : concave_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s)
  {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) (hfy : f (a • x + b • y) ≤ f y) :
  f x ≤ f (a • x + b • y) :=
hf.dual.le_left_of_right_le' hx hy ha hb hab hfy

lemma convex_on.le_right_of_left_le' (hf : convex_on 𝕜 s f) {x y : E} {a b : 𝕜}
  (hx : x ∈ s) (hy : y ∈ s) (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1)
  (hfx : f x ≤ f (a • x + b • y)) :
  f (a • x + b • y) ≤ f y :=
begin
  rw add_comm at ⊢ hab hfx,
  exact hf.le_left_of_right_le' hy hx hb ha hab hfx,
end

lemma concave_on.le_right_of_left_le' (hf : concave_on 𝕜 s f) {x y : E} {a b : 𝕜}
  (hx : x ∈ s) (hy : y ∈ s) (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1)
  (hfx : f (a • x + b • y) ≤ f x) :
  f y ≤ f (a • x + b • y) :=
hf.dual.le_right_of_left_le' hx hy ha hb hab hfx

lemma convex_on.le_left_of_right_le (hf : convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f y ≤ f z) :
  f z ≤ f x :=
begin
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz,
  exact hf.le_left_of_right_le' hx hy ha hb.le hab hyz,
end

lemma concave_on.left_le_of_le_right (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f z ≤ f y) :
  f x ≤ f z :=
hf.dual.le_left_of_right_le hx hy hz hyz

lemma convex_on.le_right_of_left_le (hf : convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f x ≤ f z) :
  f z ≤ f y :=
begin
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz,
  exact hf.le_right_of_left_le' hx hy ha.le hb hab hxz,
end

lemma concave_on.le_right_of_left_le (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f z ≤ f x) :
  f y ≤ f z :=
hf.dual.le_right_of_left_le hx hy hz hxz

end ordered_smul

section module
variables [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f g : E → β}

/- The following lemmas don't require `module 𝕜 E` if you add the hypothesis `x ≠ y`. At the time of
the writing, we decided the resulting lemmas wouldn't be useful. Feel free to reintroduce them. -/
lemma strict_convex_on.lt_left_of_right_lt' (hf : strict_convex_on 𝕜 s f) {x y : E} (hx : x ∈ s)
  (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1)
  (hfy : f y < f (a • x + b • y)) :
  f (a • x + b • y) < f x :=
not_le.1 $ λ h, lt_irrefl (f (a • x + b • y)) $
  calc
    f (a • x + b • y)
        < a • f x + b • f y : hf.2 hx hy begin
            rintro rfl,
            rw convex.combo_self hab at hfy,
            exact lt_irrefl _ hfy,
          end ha hb hab
    ... < a • f (a • x + b • y) + b • f (a • x + b • y)
        : add_lt_add_of_le_of_lt (smul_le_smul_of_nonneg h ha.le) (smul_lt_smul_of_pos hfy hb)
    ... = f (a • x + b • y) : convex.combo_self hab _

lemma strict_concave_on.left_lt_of_lt_right' (hf : strict_concave_on 𝕜 s f) {x y : E} (hx : x ∈ s)
  (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1)
  (hfy : f (a • x + b • y) < f y) :
  f x < f (a • x + b • y) :=
hf.dual.lt_left_of_right_lt' hx hy ha hb hab hfy

lemma strict_convex_on.lt_right_of_left_lt' (hf : strict_convex_on 𝕜 s f) {x y : E} {a b : 𝕜}
  (hx : x ∈ s) (hy : y ∈ s) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1)
  (hfx : f x < f (a • x + b • y)) :
  f (a • x + b • y) < f y :=
begin
  rw add_comm at ⊢ hab hfx,
  exact hf.lt_left_of_right_lt' hy hx hb ha hab hfx,
end

lemma strict_concave_on.lt_right_of_left_lt' (hf : strict_concave_on 𝕜 s f) {x y : E} {a b : 𝕜}
  (hx : x ∈ s) (hy : y ∈ s) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1)
  (hfx : f (a • x + b • y) < f x) :
  f y < f (a • x + b • y) :=
hf.dual.lt_right_of_left_lt' hx hy ha hb hab hfx

lemma strict_convex_on.lt_left_of_right_lt (hf : strict_convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f y < f z) :
  f z < f x :=
begin
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz,
  exact hf.lt_left_of_right_lt' hx hy ha hb hab hyz,
end

lemma strict_concave_on.left_lt_of_lt_right (hf : strict_concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f z < f y) :
  f x < f z :=
hf.dual.lt_left_of_right_lt hx hy hz hyz

lemma strict_convex_on.lt_right_of_left_lt (hf : strict_convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f x < f z) :
  f z < f y :=
begin
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz,
  exact hf.lt_right_of_left_lt' hx hy ha hb hab hxz,
end

lemma strict_concave_on.lt_right_of_left_lt (hf : strict_concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s)
  (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f z < f x) :
  f y < f z :=
hf.dual.lt_right_of_left_lt hx hy hz hxz

end module
end linear_ordered_cancel_add_comm_monoid

section ordered_add_comm_group
variables [ordered_add_comm_group β] [has_scalar 𝕜 E] [module 𝕜 β] {s : set E} {f g : E → β}

/-- A function `-f` is convex iff `f` is concave. -/
@[simp] lemma neg_convex_on_iff : convex_on 𝕜 s (-f) ↔ concave_on 𝕜 s f :=
begin
  split,
  { rintro ⟨hconv, h⟩,
    refine ⟨hconv, λ x y hx hy a b ha hb hab, _⟩,
    simp [neg_apply, neg_le, add_comm] at h,
    exact h hx hy ha hb hab },
  { rintro ⟨hconv, h⟩,
    refine ⟨hconv, λ x y hx hy a b ha hb hab, _⟩,
    rw ←neg_le_neg_iff,
    simp_rw [neg_add, pi.neg_apply, smul_neg, neg_neg],
    exact h hx hy ha hb hab }
end

/-- A function `-f` is concave iff `f` is convex. -/
@[simp] lemma neg_concave_on_iff : concave_on 𝕜 s (-f) ↔ convex_on 𝕜 s f:=
by rw [← neg_convex_on_iff, neg_neg f]

/-- A function `-f` is strictly convex iff `f` is strictly concave. -/
@[simp] lemma neg_strict_convex_on_iff : strict_convex_on 𝕜 s (-f) ↔ strict_concave_on 𝕜 s f :=
begin
  split,
  { rintro ⟨hconv, h⟩,
    refine ⟨hconv, λ x y hx hy hxy a b ha hb hab, _⟩,
    simp [neg_apply, neg_lt, add_comm] at h,
    exact h hx hy hxy ha hb hab },
  { rintro ⟨hconv, h⟩,
    refine ⟨hconv, λ x y hx hy hxy a b ha hb hab, _⟩,
    rw ←neg_lt_neg_iff,
    simp_rw [neg_add, pi.neg_apply, smul_neg, neg_neg],
    exact h hx hy hxy ha hb hab }
end

/-- A function `-f` is strictly concave iff `f` is strictly convex. -/
@[simp] lemma neg_strict_concave_on_iff : strict_concave_on 𝕜 s (-f) ↔ strict_convex_on 𝕜 s f :=
by rw [← neg_strict_convex_on_iff, neg_neg f]

alias neg_convex_on_iff ↔ _ concave_on.neg
alias neg_concave_on_iff ↔ _ convex_on.neg
alias neg_strict_convex_on_iff ↔ _ strict_concave_on.neg
alias neg_strict_concave_on_iff ↔ _ strict_convex_on.neg

lemma convex_on.sub (hf : convex_on 𝕜 s f) (hg : concave_on 𝕜 s g) : convex_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add hg.neg

lemma concave_on.sub (hf : concave_on 𝕜 s f) (hg : convex_on 𝕜 s g) : concave_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add hg.neg

lemma strict_convex_on.sub (hf : strict_convex_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add hg.neg

lemma strict_concave_on.sub (hf : strict_concave_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add hg.neg

lemma convex_on.sub_strict_concave_on (hf : convex_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add_strict_convex_on hg.neg

lemma concave_on.sub_strict_convex_on (hf : concave_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add_strict_concave_on hg.neg

lemma strict_convex_on.sub_concave_on (hf : strict_convex_on 𝕜 s f) (hg : concave_on 𝕜 s g) :
  strict_convex_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add_convex_on hg.neg

lemma strict_concave_on.sub_convex_on (hf : strict_concave_on 𝕜 s f) (hg : convex_on 𝕜 s g) :
  strict_concave_on 𝕜 s (f - g) :=
(sub_eq_add_neg f g).symm ▸ hf.add_concave_on hg.neg

end ordered_add_comm_group
end add_comm_monoid

section add_cancel_comm_monoid
variables [add_cancel_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E] [has_scalar 𝕜 β]
  {s : set E} {f : E → β}

/-- Right translation preserves strict convexity. -/
lemma strict_convex_on.translate_right (hf : strict_convex_on 𝕜 s f) (c : E) :
  strict_convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) :=
⟨hf.1.translate_preimage_right _, λ x y hx hy hxy a b ha hb hab,
  calc
    f (c + (a • x + b • y)) = f (a • (c + x) + b • (c + y))
        : by rw [smul_add, smul_add, add_add_add_comm, convex.combo_self hab]
    ... < a • f (c + x) + b • f (c + y) : hf.2 hx hy ((add_right_injective c).ne hxy) ha hb hab⟩

/-- Right translation preserves strict concavity. -/
lemma strict_concave_on.translate_right (hf : strict_concave_on 𝕜 s f) (c : E) :
  strict_concave_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) :=
hf.dual.translate_right _

/-- Left translation preserves strict convexity. -/
lemma strict_convex_on.translate_left (hf : strict_convex_on 𝕜 s f) (c : E) :
  strict_convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, z + c)) :=
by simpa only [add_comm] using hf.translate_right _

/-- Left translation preserves strict concavity. -/
lemma strict_concave_on.translate_left (hf : strict_concave_on 𝕜 s f) (c : E) :
  strict_concave_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, z + c)) :=
by simpa only [add_comm] using hf.translate_right _

end add_cancel_comm_monoid
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜] [add_comm_monoid E]

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid β]

section module
variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.smul {c : 𝕜} (hc : 0 ≤ c) (hf : convex_on 𝕜 s f) : convex_on 𝕜 s (λ x, c • f x) :=
⟨hf.1, λ x y hx hy a b ha hb hab,
  calc
    c • f (a • x + b • y) ≤ c • (a • f x + b • f y)
      : smul_le_smul_of_nonneg (hf.2 hx hy ha hb hab) hc
    ... = a • (c • f x) + b • (c • f y)
      : by rw [smul_add, smul_comm c, smul_comm c]; apply_instance⟩

lemma concave_on.smul {c : 𝕜} (hc : 0 ≤ c) (hf : concave_on 𝕜 s f) :
  concave_on 𝕜 s (λ x, c • f x) :=
hf.dual.smul hc

end module
end ordered_add_comm_monoid
end ordered_comm_semiring

section ordered_ring
variables [linear_ordered_field 𝕜] [add_comm_group E] [add_comm_group F]

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid β]

section module
variables [module 𝕜 E] [module 𝕜 F] [has_scalar 𝕜 β]

/-- If a function is convex on `s`, it remains convex when precomposed by an affine map. -/
lemma convex_on.comp_affine_map {f : F → β} (g : E →ᵃ[𝕜] F) {s : set F} (hf : convex_on 𝕜 s f) :
  convex_on 𝕜 (g ⁻¹' s) (f ∘ g) :=
⟨hf.1.affine_preimage _, λ x y hx hy a b ha hb hab,
  calc
    (f ∘ g) (a • x + b • y) = f (g (a • x + b • y))         : rfl
                       ...  = f (a • (g x) + b • (g y))     : by rw [convex.combo_affine_apply hab]
                       ...  ≤ a • f (g x) + b • f (g y)     : hf.2 hx hy ha hb hab⟩

/-- If a function is concave on `s`, it remains concave when precomposed by an affine map. -/
lemma concave_on.comp_affine_map {f : F → β} (g : E →ᵃ[𝕜] F) {s : set F} (hf : concave_on 𝕜 s f) :
  concave_on 𝕜 (g ⁻¹' s) (f ∘ g) :=
hf.dual.comp_affine_map g

end module
end ordered_add_comm_monoid
end ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜] [add_comm_monoid E]

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid β]

section has_scalar
variables [has_scalar 𝕜 E] [has_scalar 𝕜 β] {s : set E}

lemma convex_on_iff_div {f : E → β} :
  convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → 0 < a + b
  → f ((a/(a+b)) • x + (b/(a+b)) • y) ≤ (a/(a+b)) • f x + (b/(a+b)) • f y :=
and_congr iff.rfl
⟨begin
  intros h x y hx hy a b ha hb hab,
  apply h hx hy (div_nonneg ha hab.le) (div_nonneg hb hab.le),
  rw [←add_div, div_self hab.ne'],
end,
begin
  intros h x y hx hy a b ha hb hab,
  simpa [hab, zero_lt_one] using h hx hy ha hb,
end⟩

lemma concave_on_iff_div {f : E → β} :
  concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b
  → 0 < a + b → (a/(a+b)) • f x + (b/(a+b)) • f y ≤ f ((a/(a+b)) • x + (b/(a+b)) • y) :=
@convex_on_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _

lemma strict_convex_on_iff_div {f : E → β} :
  strict_convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a
    → 0 < b → f ((a/(a+b)) • x + (b/(a+b)) • y) < (a/(a+b)) • f x + (b/(a+b)) • f y :=
and_congr iff.rfl
⟨begin
  intros h x y hx hy hxy a b ha hb,
  have hab := add_pos ha hb,
  apply h hx hy hxy (div_pos ha hab) (div_pos hb hab),
  rw [←add_div, div_self hab.ne'],
end,
begin
  intros h x y hx hy hxy a b ha hb hab,
  simpa [hab, zero_lt_one] using h hx hy hxy ha hb,
end⟩

lemma strict_concave_on_iff_div {f : E → β} :
  strict_concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a
    → 0 < b → (a/(a+b)) • f x + (b/(a+b)) • f y < f ((a/(a+b)) • x + (b/(a+b)) • y) :=
@strict_convex_on_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _

end has_scalar
end ordered_add_comm_monoid
end linear_ordered_field


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import category_theory.concrete_category.bundled_hom
import category_theory.elementwise
import topology.continuous_function.basic

/-!
# Category instance for topological spaces

We introduce the bundled category `Top` of topological spaces together with the functors `discrete`
and `trivial` from the category of types to `Top` which equip a type with the corresponding
discrete, resp. trivial, topology. For a proof that these functors are left, resp. right adjoint
to the forgetful functor, see `topology.category.Top.adjunctions`.
-/

open category_theory
open topological_space

universe u

/-- The category of topological spaces and continuous maps. -/
def Top : Type (u+1) := bundled topological_space

namespace Top

instance bundled_hom : bundled_hom @continuous_map :=
⟨@continuous_map.to_fun, @continuous_map.id, @continuous_map.comp, @continuous_map.coe_injective⟩

attribute [derive [large_category, concrete_category]] Top

instance : has_coe_to_sort Top Type* := bundled.has_coe_to_sort

instance topological_space_unbundled (x : Top) : topological_space x := x.str

@[simp] lemma id_app (X : Top.{u}) (x : X) :
  (𝟙 X : X → X) x = x := rfl

@[simp] lemma comp_app {X Y Z : Top.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g : X → Z) x = g (f x) := rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top := ⟨X⟩

instance (X : Top) : topological_space X := X.str

@[simp] lemma coe_of (X : Type u) [topological_space X] : (of X : Type u) = X := rfl

instance : inhabited Top := ⟨Top.of empty⟩

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊥⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_bot } }

instance {X : Type u} : discrete_topology (discrete.obj X) := ⟨rfl⟩

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊤⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_top } }

/-- Any homeomorphisms induces an isomorphism in `Top`. -/
@[simps] def iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f⟩,
  inv := ⟨f.symm⟩ }

/-- Any isomorphism in `Top` induces a homeomorphism. -/
@[simps] def homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp,
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

@[simp] lemma of_iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : homeo_of_iso (iso_of_homeo f) = f :=
by { ext, refl }

@[simp] lemma of_homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : iso_of_homeo (homeo_of_iso f) = f :=
by { ext, refl }

@[simp]
lemma open_embedding_iff_comp_is_iso {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] :
  open_embedding (f ≫ g) ↔ open_embedding f :=
(Top.homeo_of_iso (as_iso g)).open_embedding.of_comp_iff f

@[simp]
lemma open_embedding_iff_is_iso_comp {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] :
  open_embedding (f ≫ g) ↔ open_embedding g :=
begin
  split,
  { intro h,
    convert h.comp (Top.homeo_of_iso (as_iso f).symm).open_embedding,
    exact congr_arg _ (is_iso.inv_hom_id_assoc f g).symm },
  { exact λ h, h.comp (Top.homeo_of_iso (as_iso f)).open_embedding }
end

end Top


import data.nat.basic
import tactic.squeeze
import data.list.perm

namespace tactic
namespace interactive
setup_tactic_parser

/-- version of squeeze_simp that tests whether the output matches the expected output -/
meta def squeeze_simp_test
  (key : parse cur_pos)
  (slow_and_accurate : parse (tk "?")?)
  (use_iota_eqn : parse (tk "!")?) (no_dflt : parse only_flag) (hs : parse simp_arg_list)
  (attr_names : parse with_ident_list) (locat : parse location)
  (cfg : parse struct_inst?)
  (_ : parse (tk "=")) (l : parse simp_arg_list) : tactic unit :=
do (cfg',c) ← parse_config cfg,
   squeeze_simp_core slow_and_accurate.is_some no_dflt hs
     (λ l_no_dft l_args, simp use_iota_eqn none l_no_dft l_args attr_names locat cfg')
     (λ args, guard ((args.map to_string).perm (l.map to_string)) <|> fail!"{args} expected.")
end interactive
end tactic

-- Test that squeeze_simp succeeds when it closes the goal.
example : 1 = 1 :=
by { squeeze_simp_test = [eq_self_iff_true] }

-- Test that `squeeze_simp` succeeds when given arguments.
example {a b : ℕ} (h : a + a = b) : b + 0 = 2 * a :=
by { squeeze_simp_test [←h, two_mul] = [←h, two_mul, add_zero] }

-- Test that the order of the given hypotheses do not matter.
example {a b : ℕ} (h : a + a = b) : b + 0 = 2 * a :=
by { squeeze_simp_test [←h, two_mul] = [←h, add_zero, two_mul] }


/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin
-/
import algebra.direct_sum.module
import linear_algebra.isomorphisms
import group_theory.torsion
import ring_theory.coprime.ideal
import ring_theory.finiteness

/-!
# Torsion submodules

## Main definitions

* `torsion_of R M x` : the torsion ideal of `x`, containing all `a` such that `a • x = 0`.
* `submodule.torsion_by R M a` : the `a`-torsion submodule, containing all elements `x` of `M` such
  that `a • x = 0`.
* `submodule.torsion_by_set R M s` : the submodule containing all elements `x` of `M` such that
  `a • x = 0` for all `a` in `s`.
* `submodule.torsion' R M S` : the `S`-torsion submodule, containing all elements `x` of `M` such
  that `a • x = 0` for some `a` in `S`.
* `submodule.torsion R M` : the torsion submoule, containing all elements `x` of `M` such that
  `a • x = 0` for some non-zero-divisor `a` in `R`.
* `module.is_torsion_by R M a` : the property that defines a `a`-torsion module. Similarly,
  `is_torsion_by_set`, `is_torsion'` and `is_torsion`.
* `module.is_torsion_by_set.module` : Creates a `R ⧸ I`-module from a `R`-module that
  `is_torsion_by_set R _ I`.

## Main statements

* `quot_torsion_of_equiv_span_singleton` : isomorphism between the span of an element of `M` and
  the quotient by its torsion ideal.
* `torsion' R M S` and `torsion R M` are submodules.
* `torsion_by_set_eq_torsion_by_span` : torsion by a set is torsion by the ideal generated by it.
* `submodule.torsion_by_is_torsion_by` : the `a`-torsion submodule is a `a`-torsion module.
  Similar lemmas for `torsion'` and `torsion`.
* `submodule.torsion_by_is_internal` : a `∏ i, p i`-torsion module is the internal direct sum of its
  `p i`-torsion submodules when the `p i` are pairwise coprime. A more general version with coprime
  ideals is `submodule.torsion_by_set_is_internal`.
* `submodule.no_zero_smul_divisors_iff_torsion_bot` : a module over a domain has
  `no_zero_smul_divisors` (that is, there is no non-zero `a`, `x` such that `a • x = 0`)
  iff its torsion submodule is trivial.
* `submodule.quotient_torsion.torsion_eq_bot` : quotienting by the torsion submodule makes the
  torsion submodule of the new module trivial. If `R` is a domain, we can derive an instance
  `submodule.quotient_torsion.no_zero_smul_divisors : no_zero_smul_divisors R (M ⧸ torsion R M)`.

## Notation

* The notions are defined for a `comm_semiring R` and a `module R M`. Some additional hypotheses on
  `R` and `M` are required by some lemmas.
* The letters `a`, `b`, ... are used for scalars (in `R`), while `x`, `y`, ... are used for vectors
  (in `M`).

## Tags

Torsion, submodule, module, quotient
-/

namespace ideal

section
variables (R M : Type*) [semiring R] [add_comm_monoid M] [module R M]
/--The torsion ideal of `x`, containing all `a` such that `a • x = 0`.-/
@[simps] def torsion_of (x : M) : ideal R := (linear_map.to_span_singleton R M x).ker
variables {R M}
@[simp] lemma mem_torsion_of_iff (x : M) (a : R) : a ∈ torsion_of R M x ↔ a • x = 0 := iff.rfl
end

section
variables (R M : Type*) [ring R] [add_comm_group M] [module R M]
/--The span of `x` in `M` is isomorphic to `R` quotiented by the torsion ideal of `x`.-/
noncomputable def quot_torsion_of_equiv_span_singleton (x : M) :
  (R ⧸ torsion_of R M x) ≃ₗ[R] (R ∙ x) :=
(linear_map.to_span_singleton R M x).quot_ker_equiv_range.trans $
linear_equiv.of_eq _ _ (linear_map.span_singleton_eq_range R M x).symm

variables {R M}
@[simp] lemma quot_torsion_of_equiv_span_singleton_apply_mk (x : M) (a : R) :
  quot_torsion_of_equiv_span_singleton R M x (submodule.quotient.mk a) =
    a • ⟨x, submodule.mem_span_singleton_self x⟩ := rfl
end
end ideal

open_locale non_zero_divisors

section defs

variables (R M : Type*) [comm_semiring R] [add_comm_monoid M] [module R M]

namespace submodule

/-- The `a`-torsion submodule for `a` in `R`, containing all elements `x` of `M` such that
  `a • x = 0`. -/
@[simps] def torsion_by (a : R) : submodule R M := (distrib_mul_action.to_linear_map _ _ a).ker

/-- The submodule containing all elements `x` of `M` such that `a • x = 0` for all `a` in `s`. -/
@[simps] def torsion_by_set (s : set R) : submodule R M := Inf (torsion_by R M '' s)

/-- The `S`-torsion submodule, containing all elements `x` of `M` such that `a • x = 0` for some
`a` in `S`. -/
@[simps] def torsion' (S : Type*)
  [comm_monoid S] [distrib_mul_action S M] [smul_comm_class S R M] :
  submodule R M :=
{ carrier := { x | ∃ a : S, a • x = 0 },
  zero_mem' := ⟨1, smul_zero _⟩,
  add_mem' := λ x y ⟨a, hx⟩ ⟨b, hy⟩,
    ⟨b * a,
      by rw [smul_add, mul_smul, mul_comm, mul_smul, hx, hy, smul_zero, smul_zero, add_zero]⟩,
  smul_mem' := λ a x ⟨b, h⟩, ⟨b, by rw [smul_comm, h, smul_zero]⟩ }

/-- The torsion submodule, containing all elements `x` of `M` such that  `a • x = 0` for some
  non-zero-divisor `a` in `R`. -/
@[reducible] def torsion := torsion' R M R⁰

end submodule

namespace module

/-- A `a`-torsion module is a module where every element is `a`-torsion. -/
@[reducible] def is_torsion_by (a : R) := ∀ ⦃x : M⦄, a • x = 0

/-- A module where every element is `a`-torsion for all `a` in `s`. -/
@[reducible] def is_torsion_by_set (s : set R) := ∀ ⦃x : M⦄ ⦃a : s⦄, (a : R) • x = 0

/-- A `S`-torsion module is a module where every element is `a`-torsion for some `a` in `S`. -/
@[reducible] def is_torsion' (S : Type*) [has_scalar S M] := ∀ ⦃x : M⦄, ∃ a : S, a • x = 0

/-- A torsion module is a module where every element is `a`-torsion for some non-zero-divisor `a`.
-/
@[reducible] def is_torsion := ∀ ⦃x : M⦄, ∃ a : R⁰, a • x = 0

end module

end defs

variables {R M : Type*}

section
variables [comm_semiring R] [add_comm_monoid M] [module R M] (s : set R) (a : R)

namespace submodule

@[simp] lemma smul_torsion_by (x : torsion_by R M a) : a • x = 0 := subtype.ext x.prop
@[simp] lemma smul_coe_torsion_by (x : torsion_by R M a) : a • (x : M) = 0 := x.prop
@[simp] lemma mem_torsion_by_iff (x : M) : x ∈ torsion_by R M a ↔ a • x = 0 := iff.rfl

@[simp] lemma mem_torsion_by_set_iff (x : M) :
  x ∈ torsion_by_set R M s ↔ ∀ a : s, (a : R) • x = 0 :=
begin
  refine ⟨λ h ⟨a, ha⟩, mem_Inf.mp h _ (set.mem_image_of_mem _ ha), λ h, mem_Inf.mpr _⟩,
  rintro _ ⟨a, ha, rfl⟩, exact h ⟨a, ha⟩
end

@[simp] lemma torsion_by_singleton_eq : torsion_by_set R M {a} = torsion_by R M a :=
begin
  ext x,
  simp only [mem_torsion_by_set_iff, set_coe.forall, subtype.coe_mk, set.mem_singleton_iff,
    forall_eq, mem_torsion_by_iff]
end

/-- Torsion by a set is torsion by the ideal generated by it. -/
lemma torsion_by_set_eq_torsion_by_span :
  torsion_by_set R M s = torsion_by_set R M (ideal.span s) :=
begin
  refine le_antisymm (λ x hx, _) (torsion_by_set_le_torsion_by_set_of_subset subset_span),
  rw mem_torsion_by_set_iff at hx ⊢,
  suffices : ideal.span s ≤ ideal.torsion_of R M x,
  { rintro ⟨a, ha⟩, exact this ha },
  rw ideal.span_le, exact λ a ha, hx ⟨a, ha⟩
end

lemma torsion_by_span_singleton_eq : torsion_by_set R M (R ∙ a) = torsion_by R M a :=
((torsion_by_set_eq_torsion_by_span _).symm.trans $ torsion_by_singleton_eq _)

lemma torsion_by_le_torsion_by_of_dvd (a b : R) (dvd : a ∣ b) :
  torsion_by R M a ≤ torsion_by R M b :=
begin
  rw [← torsion_by_span_singleton_eq, ← torsion_by_singleton_eq],
  apply torsion_by_set_le_torsion_by_set_of_subset,
  rintro c (rfl : c = b), exact ideal.mem_span_singleton.mpr dvd
end

@[simp] lemma torsion_by_one : torsion_by R M 1 = ⊥ :=
eq_bot_iff.mpr (λ _ h, by { rw [mem_torsion_by_iff, one_smul] at h, exact h })
@[simp] lemma torsion_by_univ : torsion_by_set R M set.univ = ⊥ :=
by { rw [eq_bot_iff, ← torsion_by_one, ← torsion_by_singleton_eq],
  exact torsion_by_set_le_torsion_by_set_of_subset (λ _ _, trivial) }

end submodule
open submodule
namespace module

@[simp] lemma is_torsion_by_singleton_iff : is_torsion_by_set R M {a} ↔ is_torsion_by R M a :=
begin
  refine ⟨λ h x, @h _ ⟨_, set.mem_singleton _⟩, λ h x, _⟩,
  rintro ⟨b, rfl : b = a⟩, exact @h _
end

lemma is_torsion_by_set_iff_torsion_by_set_eq_top :
  is_torsion_by_set R M s ↔ submodule.torsion_by_set R M s = ⊤ :=
⟨λ h, eq_top_iff.mpr (λ _ _, (mem_torsion_by_set_iff _ _).mpr $ @h _),
  λ h x, by { rw [← mem_torsion_by_set_iff, h], trivial }⟩

/-- A `a`-torsion module is a module whose `a`-torsion submodule is the full space. -/
lemma is_torsion_by_iff_torsion_by_eq_top : is_torsion_by R M a ↔ torsion_by R M a = ⊤ :=
by rw [← torsion_by_singleton_eq, ← is_torsion_by_singleton_iff,
  is_torsion_by_set_iff_torsion_by_set_eq_top]

lemma is_torsion_by_set_iff_is_torsion_by_span :
  is_torsion_by_set R M s ↔ is_torsion_by_set R M (ideal.span s) :=
by rw [is_torsion_by_set_iff_torsion_by_set_eq_top, is_torsion_by_set_iff_torsion_by_set_eq_top,
  torsion_by_set_eq_torsion_by_span]

lemma is_torsion_by_span_singleton_iff : is_torsion_by_set R M (R ∙ a) ↔ is_torsion_by R M a :=
((is_torsion_by_set_iff_is_torsion_by_span _).symm.trans $ is_torsion_by_singleton_iff _)

end module
namespace submodule
open module

lemma torsion_by_set_is_torsion_by_set : is_torsion_by_set R (torsion_by_set R M s) s :=
λ ⟨x, hx⟩ a, subtype.ext $ (mem_torsion_by_set_iff _ _).mp hx a

/-- The `a`-torsion submodule is a `a`-torsion module. -/
lemma torsion_by_is_torsion_by : is_torsion_by R (torsion_by R M a) a := λ _, smul_torsion_by _ _

@[simp] lemma torsion_by_torsion_by_eq_top : torsion_by R (torsion_by R M a) a = ⊤ :=
(is_torsion_by_iff_torsion_by_eq_top a).mp $ torsion_by_is_torsion_by a
@[simp] lemma torsion_by_set_torsion_by_set_eq_top :
  torsion_by_set R (torsion_by_set R M s) s = ⊤ :=
(is_torsion_by_set_iff_torsion_by_set_eq_top s).mp $ torsion_by_set_is_torsion_by_set s

variables (R M)
lemma torsion_gc : @galois_connection (submodule R M) (ideal R)ᵒᵈ _ _
  annihilator (λ I, torsion_by_set R M $ I.of_dual) :=
λ A I, ⟨λ h x hx, (mem_torsion_by_set_iff _ _).mpr $ λ ⟨a, ha⟩, mem_annihilator.mp (h ha) x hx,
  λ h a ha, mem_annihilator.mpr $ λ x hx, (mem_torsion_by_set_iff _ _).mp (h hx) ⟨a, ha⟩⟩

variables {R M}
section coprime
open_locale big_operators
variables {ι : Type*} {p : ι → ideal R} {S : finset ι}
variables (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤)
include hp

lemma supr_torsion_by_ideal_eq_torsion_by_infi :
  (⨆ i ∈ S, torsion_by_set R M $ p i) = torsion_by_set R M ↑(⨅ i ∈ S, p i) :=
begin
  cases S.eq_empty_or_nonempty with h h,
  { rw h, convert supr_emptyset, convert torsion_by_univ, convert top_coe, exact infi_emptyset },
  apply le_antisymm,
  { apply supr_le _, intro i, apply supr_le _, intro is,
    apply torsion_by_set_le_torsion_by_set_of_subset,
    exact (infi_le (λ i, ⨅ (H : i ∈ S), p i) i).trans (infi_le _ is), },
  { intros x hx,
    rw mem_supr_finset_iff_exists_sum,
    obtain ⟨μ, hμ⟩ := (mem_supr_finset_iff_exists_sum _ _).mp
      ((ideal.eq_top_iff_one _).mp $ (ideal.supr_infi_eq_top_iff_pairwise h _).mpr hp),
    refine ⟨λ i, ⟨(μ i : R) • x, _⟩, _⟩,
    { rw mem_torsion_by_set_iff at hx ⊢,
      rintro ⟨a, ha⟩, rw smul_smul,
      suffices : a * μ i ∈ ⨅ i ∈ S, p i, from hx ⟨_, this⟩,
      rw mem_infi, intro j, rw mem_infi, intro hj,
      by_cases ij : j = i,
      { rw ij, exact ideal.mul_mem_right _ _ ha },
      { have := coe_mem (μ i), simp only [mem_infi] at this,
        exact ideal.mul_mem_left _ _ (this j hj ij) } },
    { simp_rw coe_mk, rw [← finset.sum_smul, hμ, one_smul] } }
end

lemma sup_indep_torsion_by_ideal : S.sup_indep (λ i, torsion_by_set R M $ p i) :=
λ T hT i hi hiT, begin
  rw [disjoint_iff, finset.sup_eq_supr,
    supr_torsion_by_ideal_eq_torsion_by_infi $ λ i hi j hj ij, hp (hT hi) (hT hj) ij],
  have := @galois_connection.u_inf _ _ (order_dual.to_dual _) (order_dual.to_dual _) _ _ _ _
    (torsion_gc R M), dsimp at this ⊢,
  rw [← this, ideal.sup_infi_eq_top, top_coe, torsion_by_univ],
  intros j hj, apply hp hi (hT hj), rintro rfl, exact hiT hj
end

omit hp
variables {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q)
include hq

lemma supr_torsion_by_eq_torsion_by_prod :
  (⨆ i ∈ S, torsion_by R M $ q i) = torsion_by R M (∏ i in S, q i) :=
begin
  rw [← torsion_by_span_singleton_eq, ideal.submodule_span_eq,
    ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi,
    ← supr_torsion_by_ideal_eq_torsion_by_infi],
  { congr, ext : 1, congr, ext : 1, exact (torsion_by_span_singleton_eq _).symm },
  { exact λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime _ _).mpr (hq hi hj ij), }
end

lemma sup_indep_torsion_by : S.sup_indep (λ i, torsion_by R M $ q i) :=
begin
  convert sup_indep_torsion_by_ideal
    (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij),
  ext : 1, exact (torsion_by_span_singleton_eq _).symm,
end

end coprime
end submodule
end

section needs_group
variables [comm_ring R] [add_comm_group M] [module R M]

namespace submodule
open_locale big_operators
variables {ι : Type*} [decidable_eq ι] {S : finset ι}

/--If the `p i` are pairwise coprime, a `⨅ i, p i`-torsion module is the internal direct sum of
its `p i`-torsion submodules.-/
lemma torsion_by_set_is_internal {p : ι → ideal R}
  (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤)
  (hM : module.is_torsion_by_set R M (⨅ i ∈ S, p i : ideal R)) :
  direct_sum.is_internal (λ i : S, torsion_by_set R M $ p i) :=
direct_sum.is_internal_submodule_of_independent_of_supr_eq_top
  (complete_lattice.independent_iff_sup_indep.mpr $ sup_indep_torsion_by_ideal hp)
  ((supr_subtype'' ↑S $ λ i, torsion_by_set R M $ p i).trans $
    (supr_torsion_by_ideal_eq_torsion_by_infi hp).trans $
    (module.is_torsion_by_set_iff_torsion_by_set_eq_top _).mp hM)

/--If the `q i` are pairwise coprime, a `∏ i, q i`-torsion module is the internal direct sum of
its `q i`-torsion submodules.-/
lemma torsion_by_is_internal {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q)
  (hM : module.is_torsion_by R M $ ∏ i in S, q i) :
  direct_sum.is_internal (λ i : S, torsion_by R M $ q i) :=
begin
  rw [← module.is_torsion_by_span_singleton_iff, ideal.submodule_span_eq,
    ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi] at hM,
  convert torsion_by_set_is_internal
    (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij) hM,
  ext : 1, exact (torsion_by_span_singleton_eq _).symm,
end

end submodule

namespace module
variables {I : ideal R} (hM : is_torsion_by_set R M I)
include hM

/-- can't be an instance because hM can't be inferred -/
def is_torsion_by_set.has_scalar : has_scalar (R ⧸ I) M :=
{ smul := λ b x, quotient.lift_on' b (• x) $ λ b₁ b₂ h, begin
    show b₁ • x = b₂ • x,
    have : (-b₁ + b₂) • x = 0 := @hM x ⟨_, h⟩,
    rw [add_smul, neg_smul, neg_add_eq_zero] at this,
    exact this
  end }

@[simp] lemma is_torsion_by_set.mk_smul (b : R) (x : M) :
  by haveI := hM.has_scalar; exact ideal.quotient.mk I b • x = b • x := rfl

/-- A `(R ⧸ I)`-module is a `R`-module which `is_torsion_by_set R M I`. -/
def is_torsion_by_set.module : module (R ⧸ I) M :=
@function.surjective.module_left _ _ _ _ _ _ _ hM.has_scalar
  _ ideal.quotient.mk_surjective (is_torsion_by_set.mk_smul hM)

end module

namespace submodule

instance (I : ideal R) : module (R ⧸ I) (torsion_by_set R M I) :=
module.is_torsion_by_set.module $ torsion_by_set_is_torsion_by_set I

@[simp] lemma torsion_by_set.mk_smul (I : ideal R) (b : R) (x : torsion_by_set R M I) :
  ideal.quotient.mk I b • x = b • x := rfl

instance (I : ideal R) {S : Type*} [has_scalar S R] [has_scalar S M]
  [is_scalar_tower S R M] [is_scalar_tower S R R] :
  is_scalar_tower S (R ⧸ I) (torsion_by_set R M I) :=
{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) }

/-- The `a`-torsion submodule as a `(R ⧸ R∙a)`-module. -/
instance (a : R) : module (R ⧸ R ∙ a) (torsion_by R M a) :=
module.is_torsion_by_set.module $
  (module.is_torsion_by_span_singleton_iff a).mpr $ torsion_by_is_torsion_by a

@[simp] lemma torsion_by.mk_smul (a b : R) (x : torsion_by R M a) :
  ideal.quotient.mk (R ∙ a) b • x = b • x := rfl

instance (a : R) {S : Type*} [has_scalar S R] [has_scalar S M]
  [is_scalar_tower S R M] [is_scalar_tower S R R] :
  is_scalar_tower S (R ⧸ R ∙ a) (torsion_by R M a) :=
{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) }

end submodule
end needs_group

namespace submodule
section torsion'
open module

variables [comm_semiring R] [add_comm_monoid M] [module R M]
variables (S : Type*) [comm_monoid S] [distrib_mul_action S M] [smul_comm_class S R M]

@[simp] lemma mem_torsion'_iff (x : M) : x ∈ torsion' R M S ↔ ∃ a : S, a • x = 0 := iff.rfl
@[simp] lemma mem_torsion_iff (x : M) : x ∈ torsion R M ↔ ∃ a : R⁰, a • x = 0 := iff.rfl

@[simps] instance : has_scalar S (torsion' R M S) :=
⟨λ s x, ⟨s • x, by { obtain ⟨x, a, h⟩ := x, use a, dsimp, rw [smul_comm, h, smul_zero] }⟩⟩
instance : distrib_mul_action S (torsion' R M S) := subtype.coe_injective.distrib_mul_action
  ((torsion' R M S).subtype).to_add_monoid_hom (λ (c : S) x, rfl)
instance : smul_comm_class S R (torsion' R M S) := ⟨λ s a x, subtype.ext $ smul_comm _ _ _⟩

/-- A `S`-torsion module is a module whose `S`-torsion submodule is the full space. -/
lemma is_torsion'_iff_torsion'_eq_top : is_torsion' M S ↔ torsion' R M S = ⊤ :=
⟨λ h, eq_top_iff.mpr (λ _ _, @h _), λ h x, by { rw [← @mem_torsion'_iff R, h], trivial }⟩

/-- The `S`-torsion submodule is a `S`-torsion module. -/
lemma torsion'_is_torsion' : is_torsion' (torsion' R M S) S := λ ⟨x, ⟨a, h⟩⟩, ⟨a, subtype.ext h⟩

@[simp] lemma torsion'_torsion'_eq_top : torsion' R (torsion' R M S) S = ⊤ :=
(is_torsion'_iff_torsion'_eq_top S).mp $ torsion'_is_torsion' S

/-- The torsion submodule of the torsion submodule (viewed as a module) is the full
torsion module. -/
@[simp] lemma torsion_torsion_eq_top : torsion R (torsion R M) = ⊤ := torsion'_torsion'_eq_top R⁰

/-- The torsion submodule is always a torsion module. -/
lemma torsion_is_torsion : module.is_torsion R (torsion R M) := torsion'_is_torsion' R⁰
end torsion'

section torsion
variables [comm_semiring R] [add_comm_monoid M] [module R M]
open_locale big_operators

lemma is_torsion_by_ideal_of_finite_of_is_torsion [module.finite R M] (hM : module.is_torsion R M) :
  ∃ I : ideal R, (I : set R) ∩ R⁰ ≠ ∅ ∧ module.is_torsion_by_set R M I :=
begin
  cases (module.finite_def.mp infer_instance : (⊤ : submodule R M).fg) with S h,
  refine ⟨∏ x in S, ideal.torsion_of R M x, _, _⟩,
  { rw set.ne_empty_iff_nonempty,
    refine ⟨_, _, (∏ x in S, (@hM x).some : R⁰).2⟩,
    rw [subtype.val_eq_coe, submonoid.coe_finset_prod],
    apply ideal.prod_mem_prod,
    exact λ x _, (@hM x).some_spec },
  { rw [module.is_torsion_by_set_iff_torsion_by_set_eq_top, eq_top_iff, ← h, span_le],
    intros x hx, apply torsion_by_set_le_torsion_by_set_of_subset,
    { apply ideal.le_of_dvd, exact finset.dvd_prod_of_mem _ hx },
    { rw mem_torsion_by_set_iff, rintro ⟨a, ha⟩, exact ha } }
end

variables [no_zero_divisors R] [nontrivial R]

lemma coe_torsion_eq_annihilator_ne_bot :
  (torsion R M : set M) = { x : M | (R ∙ x).annihilator ≠ ⊥ } :=
begin
  ext x, simp_rw [submodule.ne_bot_iff, mem_annihilator, mem_span_singleton],
  exact ⟨λ ⟨a, hax⟩, ⟨a, λ _ ⟨b, hb⟩, by rw [← hb, smul_comm, ← submonoid.smul_def, hax, smul_zero],
    non_zero_divisors.coe_ne_zero _⟩,
    λ ⟨a, hax, ha⟩, ⟨⟨_, mem_non_zero_divisors_of_ne_zero ha⟩, hax x ⟨1, one_smul _ _⟩⟩⟩
end

/-- A module over a domain has `no_zero_smul_divisors` iff its torsion submodule is trivial. -/
lemma no_zero_smul_divisors_iff_torsion_eq_bot :
  no_zero_smul_divisors R M ↔ torsion R M = ⊥ :=
begin
  split; intro h,
  { haveI : no_zero_smul_divisors R M := h,
    rw eq_bot_iff, rintro x ⟨a, hax⟩,
    change (a : R) • x = 0 at hax,
    cases eq_zero_or_eq_zero_of_smul_eq_zero hax with h0 h0,
    { exfalso, exact non_zero_divisors.coe_ne_zero a h0 }, { exact h0 } },
  { exact { eq_zero_or_eq_zero_of_smul_eq_zero := λ a x hax, begin
      by_cases ha : a = 0,
      { left, exact ha },
      { right, rw [← mem_bot _, ← h],
        exact ⟨⟨a, mem_non_zero_divisors_of_ne_zero ha⟩, hax⟩ }
    end } }
end
end torsion

namespace quotient_torsion

variables [comm_ring R] [add_comm_group M] [module R M]

/-- Quotienting by the torsion submodule gives a torsion-free module. -/
@[simp] lemma torsion_eq_bot : torsion R (M ⧸ torsion R M) = ⊥ :=
eq_bot_iff.mpr $ λ z, quotient.induction_on' z $ λ x ⟨a, hax⟩,
begin
  rw [quotient.mk'_eq_mk, ← quotient.mk_smul, quotient.mk_eq_zero] at hax,
  rw [mem_bot, quotient.mk'_eq_mk, quotient.mk_eq_zero],
  cases hax with b h,
  exact ⟨b * a, (mul_smul _ _ _).trans h⟩
end

instance no_zero_smul_divisors [is_domain R] : no_zero_smul_divisors R (M ⧸ torsion R M) :=
no_zero_smul_divisors_iff_torsion_eq_bot.mpr torsion_eq_bot

end quotient_torsion

section p_torsion
open module
section
variables [monoid R] [add_comm_monoid M] [distrib_mul_action R M]

lemma is_torsion'_powers_iff (p : R) :
  is_torsion' M (submonoid.powers p) ↔ ∀ x : M, ∃ n : ℕ, p ^ n • x = 0 :=
⟨λ h x, let ⟨⟨a, ⟨n, rfl⟩⟩, hx⟩ := @h x in ⟨n, hx⟩,
λ h x, let ⟨n, hn⟩ := h x in ⟨⟨_, ⟨n, rfl⟩⟩, hn⟩⟩

/--In a `p ^ ∞`-torsion module (that is, a module where all elements are cancelled by scalar
multiplication by some power of `p`), the smallest `n` such that `p ^ n • x = 0`.-/
def p_order {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M)
  [Π n : ℕ, decidable (p ^ n • x = 0)] :=
nat.find $ (is_torsion'_powers_iff p).mp hM x
@[simp] lemma pow_p_order_smul {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M)
  [Π n : ℕ, decidable (p ^ n • x = 0)] : p ^ p_order hM x • x = 0 :=
nat.find_spec $ (is_torsion'_powers_iff p).mp hM x

end
variables [comm_semiring R] [add_comm_monoid M] [module R M] [Π x : M, decidable (x = 0)]

lemma exists_is_torsion_by {p : R} (hM : is_torsion' M $ submonoid.powers p)
  (d : ℕ) (hd : d ≠ 0) (s : fin d → M) (hs : span R (set.range s) = ⊤) :
  ∃ j : fin d, module.is_torsion_by R M (p ^ p_order hM (s j)) :=
begin
  let oj := list.argmax (λ i, p_order hM $ s i) (list.fin_range d),
  have hoj : oj.is_some := (option.ne_none_iff_is_some.mp $
    λ eq_none, hd $ list.fin_range_eq_nil.mp $ list.argmax_eq_none.mp eq_none),
  use option.get hoj,
  rw [is_torsion_by_iff_torsion_by_eq_top, eq_top_iff, ← hs, submodule.span_le,
    set.range_subset_iff], intro i, change _ • _ = _,
  have : p_order hM (s i) ≤ p_order hM (s $ option.get hoj) :=
    list.le_of_mem_argmax (list.mem_fin_range i) (option.get_mem hoj),
  rw [← nat.sub_add_cancel this, pow_add, mul_smul, pow_p_order_smul, smul_zero]
end

end p_torsion
end submodule

namespace ideal.quotient

open submodule

lemma torsion_by_eq_span_singleton {R : Type*} [comm_ring R] (a b : R) (ha : a ∈ R⁰) :
  torsion_by R (R ⧸ R ∙ a * b) a = R ∙ (mk _ b) :=
begin
  ext x, rw [mem_torsion_by_iff, mem_span_singleton],
  obtain ⟨x, rfl⟩ := mk_surjective x, split; intro h,
  { rw [← mk_eq_mk, ← quotient.mk_smul, quotient.mk_eq_zero, mem_span_singleton] at h,
    obtain ⟨c, h⟩ := h, rw [smul_eq_mul, smul_eq_mul, mul_comm, mul_assoc,
      mul_cancel_left_mem_non_zero_divisor ha, mul_comm] at h,
    use c, rw [← h, ← mk_eq_mk, ← quotient.mk_smul, smul_eq_mul, mk_eq_mk] },
  { obtain ⟨c, h⟩ := h,
    rw [← h, smul_comm, ← mk_eq_mk, ← quotient.mk_smul,
      (quotient.mk_eq_zero _).mpr $ mem_span_singleton_self _, smul_zero] }
end
end ideal.quotient

namespace add_monoid

theorem is_torsion_iff_is_torsion_nat [add_comm_monoid M] :
  add_monoid.is_torsion M ↔ module.is_torsion ℕ M :=
begin
  refine ⟨λ h x, _, λ h x, _⟩,
  { obtain ⟨n, h0, hn⟩ := (is_of_fin_add_order_iff_nsmul_eq_zero x).mp (h x),
    exact ⟨⟨n, mem_non_zero_divisors_of_ne_zero $ ne_of_gt h0⟩, hn⟩ },
  { rw is_of_fin_add_order_iff_nsmul_eq_zero,
    obtain ⟨n, hn⟩ := @h x,
    refine ⟨n, nat.pos_of_ne_zero (non_zero_divisors.coe_ne_zero _), hn⟩ }
end

theorem is_torsion_iff_is_torsion_int [add_comm_group M] :
  add_monoid.is_torsion M ↔ module.is_torsion ℤ M :=
begin
  refine ⟨λ h x, _, λ h x, _⟩,
  { obtain ⟨n, h0, hn⟩ := (is_of_fin_add_order_iff_nsmul_eq_zero x).mp (h x),
    exact ⟨⟨n, mem_non_zero_divisors_of_ne_zero $ ne_of_gt $ int.coe_nat_pos.mpr h0⟩,
      (coe_nat_zsmul _ _).trans hn⟩ },
  { rw is_of_fin_add_order_iff_nsmul_eq_zero,
    obtain ⟨n, hn⟩ := @h x,
    exact exists_nsmul_eq_zero_of_zsmul_eq_zero (non_zero_divisors.coe_ne_zero n) hn }
end

end add_monoid


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.interactive
import Mathlib.tactic.norm_num
import Mathlib.PostPort

namespace Mathlib

/-!
# `field_simp` tactic

Tactic to clear denominators in algebraic expressions, based on `simp` with a specific simpset.
-/

namespace tactic

/-- Try to prove a goal of the form `x ≠ 0` by calling `assumption`, or `norm_num1` if `x` is
a numeral. -/
namespace interactive

/--
The goal of `field_simp` is to reduce an expression in a field to an expression of the form `n / d`
where neither `n` nor `d` contains any division symbol, just using the simplifier (with a carefully
crafted simpset named `field_simps`) to reduce the number of division symbols whenever possible by
iterating the following steps:

- write an inverse as a division
- in any product, move the division to the right
- if there are several divisions in a product, group them together at the end and write them as a
  single division
- reduce a sum to a common denominator

If the goal is an equality, this simpset will also clear the denominators, so that the proof
can normally be concluded by an application of `ring` or `ring_exp`.

`field_simp [hx, hy]` is a short form for
`simp [-one_div, -mul_eq_zero, hx, hy] with field_simps {discharger := [field_simp.ne_zero]}`

Note that this naive algorithm will not try to detect common factors in denominators to reduce the
complexity of the resulting expression. Instead, it relies on the ability of `ring` to handle
complicated expressions in the next step.

As always with the simplifier, reduction steps will only be applied if the preconditions of the
lemmas can be checked. This means that proofs that denominators are nonzero should be included. The
fact that a product is nonzero when all factors are, and that a power of a nonzero number is
nonzero, are included in the simpset, but more complicated assertions (especially dealing with sums)
should be given explicitly. If your expression is not completely reduced by the simplifier
invocation, check the denominators of the resulting expression and provide proofs that they are
nonzero to enable further progress.

To check that denominators are nonzero, `field_simp` will look for facts in the context, and
will try to apply `norm_num` to close numerical goals.

The invocation of `field_simp` removes the lemma `one_div` from the simpset, as this lemma
works against the algorithm explained above. It also removes
`mul_eq_zero : x * y = 0 ↔ x = 0 ∨ y = 0`, as `norm_num` can not work on disjunctions to
close goals of the form `24 ≠ 0`, and replaces it with `mul_ne_zero : x ≠ 0 → y ≠ 0 → x * y ≠ 0`
creating two goals instead of a disjunction.

For example,
```lean
example (a b c d x y : ℂ) (hx : x ≠ 0) (hy : y ≠ 0) :
  a + b / x + c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x + c) / x) :=
begin
  field_simp,
  ring
end
```

See also the `cancel_denoms` tactic, which tries to do a similar simplification for expressions
that have numerals in denominators.
The tactics are not related: `cancel_denoms` will only handle numeric denominators, and will try to
entirely remove (numeric) division from the expression by multiplying by a factor.
-/
end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Simon Hudon, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.equiv_rw
import Mathlib.PostPort

namespace Mathlib

/-!
## The `transport` tactic

`transport` attempts to move an `s : S α` expression across an equivalence `e : α ≃ β` to solve
a goal of the form `S β`, by building the new object field by field, taking each field of `s`
and rewriting it along `e` using the `equiv_rw` tactic.

We try to ensure good definitional properties, so that, for example, when we transport a `monoid α`
to a `monoid β`, the new multiplication is definitionally `λ x y, e (e.symm a * e.symm b)`.
-/

namespace tactic

/--
Given `s : S α` for some structure `S` depending on a type `α`,
and an equivalence `e : α ≃ β`,
try to produce an `S β`,
by transporting data and axioms across `e` using `equiv_rw`.
-/
namespace interactive

/--
Given a goal `⊢ S β` for some type class `S`, and an equivalence `e : α ≃ β`.
`transport using e` will look for a hypothesis `s : S α`,
and attempt to close the goal by transporting `s` across the equivalence `e`.

```lean
example {α : Type} [ring α] {β : Type} (e : α ≃ β) : ring β :=
by transport using e.
```

You can specify the object to transport using `transport s using e`.

`transport` works by attempting to copy each of the operations and axiom fields of `s`,
rewriting them using `equiv_rw e` and defining a new structure using these rewritten fields.

If it fails to fill in all the new fields, `transport` will produce new subgoals.
It's probably best to think about which missing `simp` lemmas would have allowed `transport`
to finish, rather than solving these goals by hand.
(This may require looking at the implementation of `tranport` to understand its algorithm;
there are several examples of "transport-by-hand" at the end of `test/equiv_rw.lean`,
which `transport` is an abstraction of.)
-/
end Mathlib