/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.finset.basic
import data.multiset.pi

/-!
# The cartesian product of finsets
-/

namespace finset
open multiset

/-! ### pi -/
section pi
variables {α : Type*}

/-- The empty dependent product function, defined on the empty set. The assumption `a ∈ ∅` is never
satisfied. -/
def pi.empty (β : α → Sort*) (a : α) (h : a ∈ (∅ : finset α)) : β a :=
multiset.pi.empty β a h

variables {δ : α → Type*} [decidable_eq α]

/-- Given a finset `s` of `α` and for all `a : α` a finset `t a` of `δ a`, then one can define the
finset `s.pi t` of all functions defined on elements of `s` taking values in `t a` for `a ∈ s`.
Note that the elements of `s.pi t` are only partially defined, on `s`. -/
def pi (s : finset α) (t : Πa, finset (δ a)) : finset (Πa∈s, δ a) :=
⟨s.1.pi (λ a, (t a).1), s.nodup.pi $ λ a _, (t a).nodup⟩

@[simp] lemma pi_val (s : finset α) (t : Πa, finset (δ a)) :
  (s.pi t).1 = s.1.pi (λ a, (t a).1) := rfl

@[simp] lemma mem_pi {s : finset α} {t : Πa, finset (δ a)} {f : Πa∈s, δ a} :
  f ∈ s.pi t ↔ (∀a (h : a ∈ s), f a h ∈ t a) :=
mem_pi _ _ _

/-- Given a function `f` defined on a finset `s`, define a new function on the finset `s ∪ {a}`,
equal to `f` on `s` and sending `a` to a given value `b`. This function is denoted
`s.pi.cons a b f`. If `a` already belongs to `s`, the new function takes the value `b` at `a`
anyway. -/
def pi.cons (s : finset α) (a : α) (b : δ a) (f : Πa, a ∈ s → δ a) (a' : α) (h : a' ∈ insert a s) :
  δ a' :=
multiset.pi.cons s.1 a b f _ (multiset.mem_cons.2 $ mem_insert.symm.2 h)

@[simp]
lemma pi.cons_same (s : finset α) (a : α) (b : δ a) (f : Πa, a ∈ s → δ a) (h : a ∈ insert a s) :
  pi.cons s a b f a h = b :=
multiset.pi.cons_same _

lemma pi.cons_ne {s : finset α} {a a' : α} {b : δ a} {f : Πa, a ∈ s → δ a} {h : a' ∈ insert a s}
  (ha : a ≠ a') :
  pi.cons s a b f a' h = f a' ((mem_insert.1 h).resolve_left ha.symm) :=
multiset.pi.cons_ne _ _

lemma pi_cons_injective  {a : α} {b : δ a} {s : finset α} (hs : a ∉ s) :
  function.injective (pi.cons s a b) :=
assume e₁ e₂ eq,
@multiset.pi_cons_injective α _ δ a b s.1 hs _ _ $
  funext $ assume e, funext $ assume h,
  have pi.cons s a b e₁ e (by simpa only [multiset.mem_cons, mem_insert] using h) =
    pi.cons s a b e₂ e (by simpa only [multiset.mem_cons, mem_insert] using h),
  { rw [eq] },
  this

@[simp] lemma pi_empty {t : Πa:α, finset (δ a)} :
  pi (∅ : finset α) t = singleton (pi.empty δ) := rfl

@[simp] lemma pi_insert [∀a, decidable_eq (δ a)]
  {s : finset α} {t : Πa:α, finset (δ a)} {a : α} (ha : a ∉ s) :
  pi (insert a s) t = (t a).bUnion (λb, (pi s t).image (pi.cons s a b)) :=
begin
  apply eq_of_veq,
  rw ← (pi (insert a s) t).2.dedup,
  refine (λ s' (h : s' = a ::ₘ s.1), (_ : dedup (multiset.pi s' (λ a, (t a).1)) =
    dedup ((t a).1.bind $ λ b,
    dedup $ (multiset.pi s.1 (λ (a : α), (t a).val)).map $
      λ f a' h', multiset.pi.cons s.1 a b f a' (h ▸ h')))) _ (insert_val_of_not_mem ha),
  subst s', rw pi_cons,
  congr, funext b,
  exact ((pi s t).nodup.map $ multiset.pi_cons_injective ha).dedup.symm,
end

lemma pi_singletons {β : Type*} (s : finset α) (f : α → β) :
  s.pi (λ a, ({f a} : finset β)) = {λ a _, f a} :=
begin
  rw eq_singleton_iff_unique_mem,
  split,
  { simp },
  intros a ha,
  ext i hi,
  rw [mem_pi] at ha,
  simpa using ha i hi,
end

lemma pi_const_singleton {β : Type*} (s : finset α) (i : β) :
  s.pi (λ _, ({i} : finset β)) = {λ _ _, i} :=
pi_singletons s (λ _, i)

lemma pi_subset {s : finset α} (t₁ t₂ : Πa, finset (δ a)) (h : ∀ a ∈ s, t₁ a ⊆ t₂ a) :
  s.pi t₁ ⊆ s.pi t₂ :=
λ g hg, mem_pi.2 $ λ a ha, h a ha (mem_pi.mp hg a ha)

lemma pi_disjoint_of_disjoint {δ : α → Type*} [∀a, decidable_eq (δ a)]
  {s : finset α} [decidable_eq (Πa∈s, δ a)]
  (t₁ t₂ : Πa, finset (δ a)) {a : α} (ha : a ∈ s) (h : disjoint (t₁ a) (t₂ a)) :
  disjoint (s.pi t₁) (s.pi t₂) :=
disjoint_iff_ne.2 $ λ f₁ hf₁ f₂ hf₂ eq₁₂,
  disjoint_iff_ne.1 h (f₁ a ha) (mem_pi.mp hf₁ a ha) (f₂ a ha) (mem_pi.mp hf₂ a ha)
  $ congr_fun (congr_fun eq₁₂ a) ha

end pi
end finset


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u

namespace Mathlib

namespace subtype

def exists_of_subtype {α : Type u} {p : α → Prop} : (Subtype fun (x : α) => p x) → ∃ (x : α), p x :=
  sorry

theorem tag_irrelevant {α : Type u} {p : α → Prop} {a : α} (h1 : p a) (h2 : p a) :
    { val := a, property := h1 } = { val := a, property := h2 } :=
  rfl

protected theorem eq {α : Type u} {p : α → Prop} {a1 : Subtype fun (x : α) => p x}
    {a2 : Subtype fun (x : α) => p x} : val a1 = val a2 → a1 = a2 :=
  sorry

theorem ne_of_val_ne {α : Type u} {p : α → Prop} {a1 : Subtype fun (x : α) => p x}
    {a2 : Subtype fun (x : α) => p x} : val a1 ≠ val a2 → a1 ≠ a2 :=
  mt (congr_arg fun {a1 : Subtype fun (x : α) => p x} => val a1)

@[simp] theorem eta {α : Type u} {p : α → Prop} (a : Subtype fun (x : α) => p x) (h : p (val a)) :
    { val := val a, property := h } = a :=
  subtype.eq rfl

end subtype

protected instance subtype.inhabited {α : Type u} {p : α → Prop} {a : α} (h : p a) :
    Inhabited (Subtype fun (x : α) => p x) :=
  { default := { val := a, property := h } }

end Mathlib


/-
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

! This file was ported from Lean 3 source module analysis.convex.function
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Basic

/-!
# 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 LinearMap Set

open BigOperators Classical Convex Pointwise

variable {𝕜 E F α β ι : Type _}

section OrderedSemiring

variable [OrderedSemiring 𝕜]

section AddCommMonoid

variable [AddCommMonoid E] [AddCommMonoid F]

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid α] [OrderedAddCommMonoid β]

section SMul

variable (𝕜) [SMul 𝕜 E] [SMul 𝕜 α] [SMul 𝕜 β] (s : Set E) (f : E → β) {g : β → α}

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

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

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

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

variable {𝕜 s f}

open OrderDual (toDual ofDual)

theorem ConvexOn.dual (hf : ConvexOn 𝕜 s f) : ConcaveOn 𝕜 s (toDual ∘ f) :=
  hf
#align convex_on.dual ConvexOn.dual

theorem ConcaveOn.dual (hf : ConcaveOn 𝕜 s f) : ConvexOn 𝕜 s (toDual ∘ f) :=
  hf
#align concave_on.dual ConcaveOn.dual

theorem StrictConvexOn.dual (hf : StrictConvexOn 𝕜 s f) : StrictConcaveOn 𝕜 s (toDual ∘ f) :=
  hf
#align strict_convex_on.dual StrictConvexOn.dual

theorem StrictConcaveOn.dual (hf : StrictConcaveOn 𝕜 s f) : StrictConvexOn 𝕜 s (toDual ∘ f) :=
  hf
#align strict_concave_on.dual StrictConcaveOn.dual

theorem convexOn_id {s : Set β} (hs : Convex 𝕜 s) : ConvexOn 𝕜 s id :=
  ⟨hs, by
    intros
    rfl⟩
#align convex_on_id convexOn_id

theorem concaveOn_id {s : Set β} (hs : Convex 𝕜 s) : ConcaveOn 𝕜 s id :=
  ⟨hs, by
    intros
    rfl⟩
#align concave_on_id concaveOn_id

theorem ConvexOn.subset {t : Set E} (hf : ConvexOn 𝕜 t f) (hst : s ⊆ t) (hs : Convex 𝕜 s) :
    ConvexOn 𝕜 s f :=
  ⟨hs, fun x hx y hy => hf.2 (hst hx) (hst hy)⟩
#align convex_on.subset ConvexOn.subset

theorem ConcaveOn.subset {t : Set E} (hf : ConcaveOn 𝕜 t f) (hst : s ⊆ t) (hs : Convex 𝕜 s) :
    ConcaveOn 𝕜 s f :=
  ⟨hs, fun x hx y hy => hf.2 (hst hx) (hst hy)⟩
#align concave_on.subset ConcaveOn.subset

theorem StrictConvexOn.subset {t : Set E} (hf : StrictConvexOn 𝕜 t f) (hst : s ⊆ t)
    (hs : Convex 𝕜 s) : StrictConvexOn 𝕜 s f :=
  ⟨hs, fun x hx y hy => hf.2 (hst hx) (hst hy)⟩
#align strict_convex_on.subset StrictConvexOn.subset

theorem StrictConcaveOn.subset {t : Set E} (hf : StrictConcaveOn 𝕜 t f) (hst : s ⊆ t)
    (hs : Convex 𝕜 s) : StrictConcaveOn 𝕜 s f :=
  ⟨hs, fun x hx y hy => hf.2 (hst hx) (hst hy)⟩
#align strict_concave_on.subset StrictConcaveOn.subset

theorem ConvexOn.comp (hg : ConvexOn 𝕜 (f '' s) g) (hf : ConvexOn 𝕜 s f)
    (hg' : MonotoneOn g (f '' s)) : ConvexOn 𝕜 s (g ∘ f) :=
  ⟨hf.1, fun x hx y hy a b ha hb hab =>
    (hg' (mem_image_of_mem f <| hf.1 hx hy ha hb hab)
            (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab) <|
          hf.2 hx hy ha hb hab).trans <|
      hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab⟩
#align convex_on.comp ConvexOn.comp

theorem ConcaveOn.comp (hg : ConcaveOn 𝕜 (f '' s) g) (hf : ConcaveOn 𝕜 s f)
    (hg' : MonotoneOn g (f '' s)) : ConcaveOn 𝕜 s (g ∘ f) :=
  ⟨hf.1, fun x hx y hy a b ha hb hab =>
    (hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab).trans <|
      hg' (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab)
          (mem_image_of_mem f <| hf.1 hx hy ha hb hab) <|
        hf.2 hx hy ha hb hab⟩
#align concave_on.comp ConcaveOn.comp

theorem ConvexOn.comp_concaveOn (hg : ConvexOn 𝕜 (f '' s) g) (hf : ConcaveOn 𝕜 s f)
    (hg' : AntitoneOn g (f '' s)) : ConvexOn 𝕜 s (g ∘ f) :=
  hg.dual.comp hf hg'
#align convex_on.comp_concave_on ConvexOn.comp_concaveOn

theorem ConcaveOn.comp_convexOn (hg : ConcaveOn 𝕜 (f '' s) g) (hf : ConvexOn 𝕜 s f)
    (hg' : AntitoneOn g (f '' s)) : ConcaveOn 𝕜 s (g ∘ f) :=
  hg.dual.comp hf hg'
#align concave_on.comp_convex_on ConcaveOn.comp_convexOn

theorem StrictConvexOn.comp (hg : StrictConvexOn 𝕜 (f '' s) g) (hf : StrictConvexOn 𝕜 s f)
    (hg' : StrictMonoOn g (f '' s)) (hf' : s.InjOn f) : StrictConvexOn 𝕜 s (g ∘ f) :=
  ⟨hf.1, fun x hx y hy hxy a b ha hb hab =>
    (hg' (mem_image_of_mem f <| hf.1 hx hy ha.le hb.le hab)
            (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha.le hb.le hab) <|
          hf.2 hx hy hxy ha hb hab).trans <|
      hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) (mt (hf' hx hy) hxy) ha hb hab⟩
#align strict_convex_on.comp StrictConvexOn.comp

theorem StrictConcaveOn.comp (hg : StrictConcaveOn 𝕜 (f '' s) g) (hf : StrictConcaveOn 𝕜 s f)
    (hg' : StrictMonoOn g (f '' s)) (hf' : s.InjOn f) : StrictConcaveOn 𝕜 s (g ∘ f) :=
  ⟨hf.1, fun x hx y hy hxy a b ha hb hab =>
    (hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) (mt (hf' hx hy) hxy) ha hb hab).trans <|
      hg' (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha.le hb.le hab)
          (mem_image_of_mem f <| hf.1 hx hy ha.le hb.le hab) <|
        hf.2 hx hy hxy ha hb hab⟩
#align strict_concave_on.comp StrictConcaveOn.comp

theorem StrictConvexOn.comp_strictConcaveOn (hg : StrictConvexOn 𝕜 (f '' s) g)
    (hf : StrictConcaveOn 𝕜 s f) (hg' : StrictAntiOn g (f '' s)) (hf' : s.InjOn f) :
    StrictConvexOn 𝕜 s (g ∘ f) :=
  hg.dual.comp hf hg' hf'
#align strict_convex_on.comp_strict_concave_on StrictConvexOn.comp_strictConcaveOn

theorem StrictConcaveOn.comp_strictConvexOn (hg : StrictConcaveOn 𝕜 (f '' s) g)
    (hf : StrictConvexOn 𝕜 s f) (hg' : StrictAntiOn g (f '' s)) (hf' : s.InjOn f) :
    StrictConcaveOn 𝕜 s (g ∘ f) :=
  hg.dual.comp hf hg' hf'
#align strict_concave_on.comp_strict_convex_on StrictConcaveOn.comp_strictConvexOn

end SMul

section DistribMulAction

variable [SMul 𝕜 E] [DistribMulAction 𝕜 β] {s : Set E} {f g : E → β}

theorem ConvexOn.add (hf : ConvexOn 𝕜 s f) (hg : ConvexOn 𝕜 s g) : ConvexOn 𝕜 s (f + g) :=
  ⟨hf.1, fun x hx y 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]
      ⟩
#align convex_on.add ConvexOn.add

theorem ConcaveOn.add (hf : ConcaveOn 𝕜 s f) (hg : ConcaveOn 𝕜 s g) : ConcaveOn 𝕜 s (f + g) :=
  hf.dual.add hg
#align concave_on.add ConcaveOn.add

end DistribMulAction

section Module

variable [SMul 𝕜 E] [Module 𝕜 β] {s : Set E} {f : E → β}

theorem convexOn_const (c : β) (hs : Convex 𝕜 s) : ConvexOn 𝕜 s fun x : E => c :=
  ⟨hs, fun x y _ _ a b _ _ hab => (Convex.combo_self hab c).ge⟩
#align convex_on_const convexOn_const

theorem concaveOn_const (c : β) (hs : Convex 𝕜 s) : ConcaveOn 𝕜 s fun x : E => c :=
  @convexOn_const _ _ βᵒᵈ _ _ _ _ _ _ c hs
#align concave_on_const concaveOn_const

theorem convexOn_of_convex_epigraph (h : Convex 𝕜 { p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2 }) :
    ConvexOn 𝕜 s f :=
  ⟨fun x hx y hy a b ha hb hab => (@h (x, f x) ⟨hx, le_rfl⟩ (y, f y) ⟨hy, le_rfl⟩ a b ha hb hab).1,
    fun x hx y hy a b ha hb hab => (@h (x, f x) ⟨hx, le_rfl⟩ (y, f y) ⟨hy, le_rfl⟩ a b ha hb hab).2⟩
#align convex_on_of_convex_epigraph convexOn_of_convex_epigraph

theorem concaveOn_of_convex_hypograph (h : Convex 𝕜 { p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1 }) :
    ConcaveOn 𝕜 s f :=
  @convexOn_of_convex_epigraph 𝕜 E βᵒᵈ _ _ _ _ _ _ _ h
#align concave_on_of_convex_hypograph concaveOn_of_convex_hypograph

end Module

section OrderedSMul

variable [SMul 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E} {f : E → β}

theorem ConvexOn.convex_le (hf : ConvexOn 𝕜 s f) (r : β) : Convex 𝕜 ({ x ∈ s | f x ≤ r }) :=
  fun x hx y 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
      ⟩
#align convex_on.convex_le ConvexOn.convex_le

theorem ConcaveOn.convex_ge (hf : ConcaveOn 𝕜 s f) (r : β) : Convex 𝕜 ({ x ∈ s | r ≤ f x }) :=
  hf.dual.convex_le r
#align concave_on.convex_ge ConcaveOn.convex_ge

theorem ConvexOn.convex_epigraph (hf : ConvexOn 𝕜 s f) :
    Convex 𝕜 { p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2 } :=
  by
  rintro ⟨x, r⟩ ⟨hx, hr⟩ ⟨y, t⟩ ⟨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)

#align convex_on.convex_epigraph ConvexOn.convex_epigraph

theorem ConcaveOn.convex_hypograph (hf : ConcaveOn 𝕜 s f) :
    Convex 𝕜 { p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1 } :=
  hf.dual.convex_epigraph
#align concave_on.convex_hypograph ConcaveOn.convex_hypograph

theorem convexOn_iff_convex_epigraph :
    ConvexOn 𝕜 s f ↔ Convex 𝕜 { p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2 } :=
  ⟨ConvexOn.convex_epigraph, convexOn_of_convex_epigraph⟩
#align convex_on_iff_convex_epigraph convexOn_iff_convex_epigraph

theorem concaveOn_iff_convex_hypograph :
    ConcaveOn 𝕜 s f ↔ Convex 𝕜 { p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1 } :=
  @convexOn_iff_convex_epigraph 𝕜 E βᵒᵈ _ _ _ _ _ _ _ f
#align concave_on_iff_convex_hypograph concaveOn_iff_convex_hypograph

end OrderedSMul

section Module

variable [Module 𝕜 E] [SMul 𝕜 β] {s : Set E} {f : E → β}

/-- Right translation preserves convexity. -/
theorem ConvexOn.translate_right (hf : ConvexOn 𝕜 s f) (c : E) :
    ConvexOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => c + z) :=
  ⟨hf.1.translate_preimage_right _, fun x hx y 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
      ⟩
#align convex_on.translate_right ConvexOn.translate_right

/-- Right translation preserves concavity. -/
theorem ConcaveOn.translate_right (hf : ConcaveOn 𝕜 s f) (c : E) :
    ConcaveOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => c + z) :=
  hf.dual.translate_right _
#align concave_on.translate_right ConcaveOn.translate_right

/-- Left translation preserves convexity. -/
theorem ConvexOn.translate_left (hf : ConvexOn 𝕜 s f) (c : E) :
    ConvexOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => z + c) := by
  simpa only [add_comm] using hf.translate_right _
#align convex_on.translate_left ConvexOn.translate_left

/-- Left translation preserves concavity. -/
theorem ConcaveOn.translate_left (hf : ConcaveOn 𝕜 s f) (c : E) :
    ConcaveOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => z + c) :=
  hf.dual.translate_left _
#align concave_on.translate_left ConcaveOn.translate_left

end Module

section Module

variable [Module 𝕜 E] [Module 𝕜 β]

theorem convexOn_iff_forall_pos {s : Set E} {f : E → β} :
    ConvexOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              y ∈ s →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y :=
  by
  refine'
    and_congr_right'
      ⟨fun h x hx y hy a b ha hb hab => h hx hy ha.le hb.le hab, fun h x hx y 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
#align convex_on_iff_forall_pos convexOn_iff_forall_pos

theorem concaveOn_iff_forall_pos {s : Set E} {f : E → β} :
    ConcaveOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              y ∈ s →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y) :=
  @convexOn_iff_forall_pos 𝕜 E βᵒᵈ _ _ _ _ _ _ _
#align concave_on_iff_forall_pos concaveOn_iff_forall_pos

theorem convexOn_iff_pairwise_pos {s : Set E} {f : E → β} :
    ConvexOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        s.Pairwise fun x y =>
          ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y :=
  by
  rw [convexOn_iff_forall_pos]
  refine'
    and_congr_right'
      ⟨fun h x hx y hy _ a b ha hb hab => h hx hy ha hb hab, fun h x hx y 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
#align convex_on_iff_pairwise_pos convexOn_iff_pairwise_pos

theorem concaveOn_iff_pairwise_pos {s : Set E} {f : E → β} :
    ConcaveOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        s.Pairwise fun x y =>
          ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y) :=
  @convexOn_iff_pairwise_pos 𝕜 E βᵒᵈ _ _ _ _ _ _ _
#align concave_on_iff_pairwise_pos concaveOn_iff_pairwise_pos

/-- A linear map is convex. -/
theorem LinearMap.convexOn (f : E →ₗ[𝕜] β) {s : Set E} (hs : Convex 𝕜 s) : ConvexOn 𝕜 s f :=
  ⟨hs, fun _ _ _ _ _ _ _ _ _ => by rw [f.map_add, f.map_smul, f.map_smul]⟩
#align linear_map.convex_on LinearMap.convexOn

/-- A linear map is concave. -/
theorem LinearMap.concaveOn (f : E →ₗ[𝕜] β) {s : Set E} (hs : Convex 𝕜 s) : ConcaveOn 𝕜 s f :=
  ⟨hs, fun _ _ _ _ _ _ _ _ _ => by rw [f.map_add, f.map_smul, f.map_smul]⟩
#align linear_map.concave_on LinearMap.concaveOn

theorem StrictConvexOn.convexOn {s : Set E} {f : E → β} (hf : StrictConvexOn 𝕜 s f) :
    ConvexOn 𝕜 s f :=
  convexOn_iff_pairwise_pos.mpr
    ⟨hf.1, fun x hx y hy hxy a b ha hb hab => (hf.2 hx hy hxy ha hb hab).le⟩
#align strict_convex_on.convex_on StrictConvexOn.convexOn

theorem StrictConcaveOn.concaveOn {s : Set E} {f : E → β} (hf : StrictConcaveOn 𝕜 s f) :
    ConcaveOn 𝕜 s f :=
  hf.dual.ConvexOn
#align strict_concave_on.concave_on StrictConcaveOn.concaveOn

section OrderedSMul

variable [OrderedSMul 𝕜 β] {s : Set E} {f : E → β}

theorem StrictConvexOn.convex_lt (hf : StrictConvexOn 𝕜 s f) (r : β) :
    Convex 𝕜 ({ x ∈ s | f x < r }) :=
  convex_iff_pairwise_pos.2 fun 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
        ⟩
#align strict_convex_on.convex_lt StrictConvexOn.convex_lt

theorem StrictConcaveOn.convex_gt (hf : StrictConcaveOn 𝕜 s f) (r : β) :
    Convex 𝕜 ({ x ∈ s | r < f x }) :=
  hf.dual.convex_lt r
#align strict_concave_on.convex_gt StrictConcaveOn.convex_gt

end OrderedSMul

section LinearOrder

variable [LinearOrder 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.
-/
theorem LinearOrder.convexOn_of_lt (hs : Convex 𝕜 s)
    (hf :
      ∀ ⦃x⦄,
        x ∈ s →
          ∀ ⦃y⦄,
            y ∈ s →
              x < y →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y) :
    ConvexOn 𝕜 s f :=
  by
  refine' convexOn_iff_pairwise_pos.2 ⟨hs, fun x hx y hy hxy a b ha hb hab => _⟩
  wlog h : x < y
  · rw [add_comm (a • x), add_comm (a • f x)]
    rw [add_comm] at hab
    refine' this hs hf y hy x hx hxy.symm b a hb ha hab (hxy.lt_or_lt.resolve_left h)
  exact hf hx hy h ha hb hab
#align linear_order.convex_on_of_lt LinearOrder.convexOn_of_lt

/-- 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. -/
theorem LinearOrder.concaveOn_of_lt (hs : Convex 𝕜 s)
    (hf :
      ∀ ⦃x⦄,
        x ∈ s →
          ∀ ⦃y⦄,
            y ∈ s →
              x < y →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y)) :
    ConcaveOn 𝕜 s f :=
  @LinearOrder.convexOn_of_lt _ _ βᵒᵈ _ _ _ _ _ _ s f hs hf
#align linear_order.concave_on_of_lt LinearOrder.concaveOn_of_lt

/-- 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 strictly 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. -/
theorem LinearOrder.strictConvexOn_of_lt (hs : Convex 𝕜 s)
    (hf :
      ∀ ⦃x⦄,
        x ∈ s →
          ∀ ⦃y⦄,
            y ∈ s →
              x < y →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) < a • f x + b • f y) :
    StrictConvexOn 𝕜 s f :=
  by
  refine' ⟨hs, fun x hx y hy hxy a b ha hb hab => _⟩
  wlog h : x < y
  · rw [add_comm (a • x), add_comm (a • f x)]
    rw [add_comm] at hab
    refine' this hs hf y hy x hx hxy.symm b a hb ha hab (hxy.lt_or_lt.resolve_left h)
  exact hf hx hy h ha hb hab
#align linear_order.strict_convex_on_of_lt LinearOrder.strictConvexOn_of_lt

/-- 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 strictly 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. -/
theorem LinearOrder.strictConcaveOn_of_lt (hs : Convex 𝕜 s)
    (hf :
      ∀ ⦃x⦄,
        x ∈ s →
          ∀ ⦃y⦄,
            y ∈ s →
              x < y →
                ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y < f (a • x + b • y)) :
    StrictConcaveOn 𝕜 s f :=
  @LinearOrder.strictConvexOn_of_lt _ _ βᵒᵈ _ _ _ _ _ _ _ _ hs hf
#align linear_order.strict_concave_on_of_lt LinearOrder.strictConcaveOn_of_lt

end LinearOrder

end Module

section Module

variable [Module 𝕜 E] [Module 𝕜 F] [SMul 𝕜 β]

/-- If `g` is convex on `s`, so is `(f ∘ g)` on `f ⁻¹' s` for a linear `f`. -/
theorem ConvexOn.comp_linearMap {f : F → β} {s : Set F} (hf : ConvexOn 𝕜 s f) (g : E →ₗ[𝕜] F) :
    ConvexOn 𝕜 (g ⁻¹' s) (f ∘ g) :=
  ⟨hf.1.linear_preimage _, fun x hx y 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
      ⟩
#align convex_on.comp_linear_map ConvexOn.comp_linearMap

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

end Module

end OrderedAddCommMonoid

section OrderedCancelAddCommMonoid

variable [OrderedCancelAddCommMonoid β]

section DistribMulAction

variable [SMul 𝕜 E] [DistribMulAction 𝕜 β] {s : Set E} {f g : E → β}

theorem StrictConvexOn.add_convexOn (hf : StrictConvexOn 𝕜 s f) (hg : ConvexOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f + g) :=
  ⟨hf.1, fun x hx y 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]
      ⟩
#align strict_convex_on.add_convex_on StrictConvexOn.add_convexOn

theorem ConvexOn.add_strictConvexOn (hf : ConvexOn 𝕜 s f) (hg : StrictConvexOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f + g) :=
  add_comm g f ▸ hg.add_convexOn hf
#align convex_on.add_strict_convex_on ConvexOn.add_strictConvexOn

theorem StrictConvexOn.add (hf : StrictConvexOn 𝕜 s f) (hg : StrictConvexOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f + g) :=
  ⟨hf.1, fun x hx y 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]
      ⟩
#align strict_convex_on.add StrictConvexOn.add

theorem StrictConcaveOn.add_concaveOn (hf : StrictConcaveOn 𝕜 s f) (hg : ConcaveOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f + g) :=
  hf.dual.add_convexOn hg.dual
#align strict_concave_on.add_concave_on StrictConcaveOn.add_concaveOn

theorem ConcaveOn.add_strictConcaveOn (hf : ConcaveOn 𝕜 s f) (hg : StrictConcaveOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f + g) :=
  hf.dual.add_strictConvexOn hg.dual
#align concave_on.add_strict_concave_on ConcaveOn.add_strictConcaveOn

theorem StrictConcaveOn.add (hf : StrictConcaveOn 𝕜 s f) (hg : StrictConcaveOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f + g) :=
  hf.dual.add hg
#align strict_concave_on.add StrictConcaveOn.add

end DistribMulAction

section Module

variable [Module 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E} {f : E → β}

theorem ConvexOn.convex_lt (hf : ConvexOn 𝕜 s f) (r : β) : Convex 𝕜 ({ x ∈ s | f x < r }) :=
  convex_iff_forall_pos.2 fun x hx y 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 _
        ⟩
#align convex_on.convex_lt ConvexOn.convex_lt

theorem ConcaveOn.convex_gt (hf : ConcaveOn 𝕜 s f) (r : β) : Convex 𝕜 ({ x ∈ s | r < f x }) :=
  hf.dual.convex_lt r
#align concave_on.convex_gt ConcaveOn.convex_gt

theorem ConvexOn.openSegment_subset_strict_epigraph (hf : ConvexOn 𝕜 s f) (p q : E × β)
    (hp : p.1 ∈ s ∧ f p.1 < p.2) (hq : q.1 ∈ s ∧ f q.1 ≤ q.2) :
    openSegment 𝕜 p q ⊆ { p : E × β | p.1 ∈ s ∧ f p.1 < p.2 } :=
  by
  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)

#align convex_on.open_segment_subset_strict_epigraph ConvexOn.openSegment_subset_strict_epigraph

theorem ConcaveOn.openSegment_subset_strict_hypograph (hf : ConcaveOn 𝕜 s f) (p q : E × β)
    (hp : p.1 ∈ s ∧ p.2 < f p.1) (hq : q.1 ∈ s ∧ q.2 ≤ f q.1) :
    openSegment 𝕜 p q ⊆ { p : E × β | p.1 ∈ s ∧ p.2 < f p.1 } :=
  hf.dual.openSegment_subset_strict_epigraph p q hp hq
#align concave_on.open_segment_subset_strict_hypograph ConcaveOn.openSegment_subset_strict_hypograph

theorem ConvexOn.convex_strict_epigraph (hf : ConvexOn 𝕜 s f) :
    Convex 𝕜 { p : E × β | p.1 ∈ s ∧ f p.1 < p.2 } :=
  convex_iff_openSegment_subset.mpr fun p hp q hq =>
    hf.openSegment_subset_strict_epigraph p q hp ⟨hq.1, hq.2.le⟩
#align convex_on.convex_strict_epigraph ConvexOn.convex_strict_epigraph

theorem ConcaveOn.convex_strict_hypograph (hf : ConcaveOn 𝕜 s f) :
    Convex 𝕜 { p : E × β | p.1 ∈ s ∧ p.2 < f p.1 } :=
  hf.dual.convex_strict_epigraph
#align concave_on.convex_strict_hypograph ConcaveOn.convex_strict_hypograph

end Module

end OrderedCancelAddCommMonoid

section LinearOrderedAddCommMonoid

variable [LinearOrderedAddCommMonoid β] [SMul 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E}
  {f g : E → β}

/-- The pointwise maximum of convex functions is convex. -/
theorem ConvexOn.sup (hf : ConvexOn 𝕜 s f) (hg : ConvexOn 𝕜 s g) : ConvexOn 𝕜 s (f ⊔ g) :=
  by
  refine' ⟨hf.left, fun x hx y 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)

#align convex_on.sup ConvexOn.sup

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

/-- The pointwise maximum of strictly convex functions is strictly convex. -/
theorem StrictConvexOn.sup (hf : StrictConvexOn 𝕜 s f) (hg : StrictConvexOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f ⊔ g) :=
  ⟨hf.left, fun x hx y 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)
        )⟩
#align strict_convex_on.sup StrictConvexOn.sup

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

/-- A convex function on a segment is upper-bounded by the max of its endpoints. -/
theorem ConvexOn.le_on_segment' (hf : ConvexOn 𝕜 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 _

#align convex_on.le_on_segment' ConvexOn.le_on_segment'

/-- A concave function on a segment is lower-bounded by the min of its endpoints. -/
theorem ConcaveOn.ge_on_segment' (hf : ConcaveOn 𝕜 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
#align concave_on.ge_on_segment' ConcaveOn.ge_on_segment'

/-- A convex function on a segment is upper-bounded by the max of its endpoints. -/
theorem ConvexOn.le_on_segment (hf : ConvexOn 𝕜 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
  hz ▸ hf.le_on_segment' hx hy ha hb hab
#align convex_on.le_on_segment ConvexOn.le_on_segment

/-- A concave function on a segment is lower-bounded by the min of its endpoints. -/
theorem ConcaveOn.ge_on_segment (hf : ConcaveOn 𝕜 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
#align concave_on.ge_on_segment ConcaveOn.ge_on_segment

/-- A strictly convex function on an open segment is strictly upper-bounded by the max of its
endpoints. -/
theorem StrictConvexOn.lt_on_open_segment' (hf : StrictConvexOn 𝕜 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 _

#align strict_convex_on.lt_on_open_segment' StrictConvexOn.lt_on_open_segment'

/-- A strictly concave function on an open segment is strictly lower-bounded by the min of its
endpoints. -/
theorem StrictConcaveOn.lt_on_open_segment' (hf : StrictConcaveOn 𝕜 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
#align strict_concave_on.lt_on_open_segment' StrictConcaveOn.lt_on_open_segment'

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

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

end LinearOrderedAddCommMonoid

section LinearOrderedCancelAddCommMonoid

variable [LinearOrderedCancelAddCommMonoid β]

section OrderedSMul

variable [SMul 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E} {f g : E → β}

theorem ConvexOn.le_left_of_right_le' (hf : ConvexOn 𝕜 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 fun 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 _

#align convex_on.le_left_of_right_le' ConvexOn.le_left_of_right_le'

theorem ConcaveOn.left_le_of_le_right' (hf : ConcaveOn 𝕜 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
#align concave_on.left_le_of_le_right' ConcaveOn.left_le_of_le_right'

theorem ConvexOn.le_right_of_left_le' (hf : ConvexOn 𝕜 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 := by
  rw [add_comm] at hab hfx⊢
  exact hf.le_left_of_right_le' hy hx hb ha hab hfx
#align convex_on.le_right_of_left_le' ConvexOn.le_right_of_left_le'

theorem ConcaveOn.right_le_of_le_left' (hf : ConcaveOn 𝕜 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
#align concave_on.right_le_of_le_left' ConcaveOn.right_le_of_le_left'

theorem ConvexOn.le_left_of_right_le (hf : ConvexOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hyz : f y ≤ f z) : f z ≤ f x :=
  by
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz
  exact hf.le_left_of_right_le' hx hy ha hb.le hab hyz
#align convex_on.le_left_of_right_le ConvexOn.le_left_of_right_le

theorem ConcaveOn.left_le_of_le_right (hf : ConcaveOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hyz : f z ≤ f y) : f x ≤ f z :=
  hf.dual.le_left_of_right_le hx hy hz hyz
#align concave_on.left_le_of_le_right ConcaveOn.left_le_of_le_right

theorem ConvexOn.le_right_of_left_le (hf : ConvexOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hxz : f x ≤ f z) : f z ≤ f y :=
  by
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz
  exact hf.le_right_of_left_le' hx hy ha.le hb hab hxz
#align convex_on.le_right_of_left_le ConvexOn.le_right_of_left_le

theorem ConcaveOn.right_le_of_le_left (hf : ConcaveOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hxz : f z ≤ f x) : f y ≤ f z :=
  hf.dual.le_right_of_left_le hx hy hz hxz
#align concave_on.right_le_of_le_left ConcaveOn.right_le_of_le_left

end OrderedSMul

section Module

variable [Module 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {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. -/
theorem ConvexOn.lt_left_of_right_lt' (hf : ConvexOn 𝕜 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 fun 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.le 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 _

#align convex_on.lt_left_of_right_lt' ConvexOn.lt_left_of_right_lt'

theorem ConcaveOn.left_lt_of_lt_right' (hf : ConcaveOn 𝕜 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
#align concave_on.left_lt_of_lt_right' ConcaveOn.left_lt_of_lt_right'

theorem ConvexOn.lt_right_of_left_lt' (hf : ConvexOn 𝕜 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 := by
  rw [add_comm] at hab hfx⊢
  exact hf.lt_left_of_right_lt' hy hx hb ha hab hfx
#align convex_on.lt_right_of_left_lt' ConvexOn.lt_right_of_left_lt'

theorem ConcaveOn.lt_right_of_left_lt' (hf : ConcaveOn 𝕜 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
#align concave_on.lt_right_of_left_lt' ConcaveOn.lt_right_of_left_lt'

theorem ConvexOn.lt_left_of_right_lt (hf : ConvexOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hyz : f y < f z) : f z < f x :=
  by
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz
  exact hf.lt_left_of_right_lt' hx hy ha hb hab hyz
#align convex_on.lt_left_of_right_lt ConvexOn.lt_left_of_right_lt

theorem ConcaveOn.left_lt_of_lt_right (hf : ConcaveOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hyz : f z < f y) : f x < f z :=
  hf.dual.lt_left_of_right_lt hx hy hz hyz
#align concave_on.left_lt_of_lt_right ConcaveOn.left_lt_of_lt_right

theorem ConvexOn.lt_right_of_left_lt (hf : ConvexOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hxz : f x < f z) : f z < f y :=
  by
  obtain ⟨a, b, ha, hb, hab, rfl⟩ := hz
  exact hf.lt_right_of_left_lt' hx hy ha hb hab hxz
#align convex_on.lt_right_of_left_lt ConvexOn.lt_right_of_left_lt

theorem ConcaveOn.lt_right_of_left_lt (hf : ConcaveOn 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s)
    (hz : z ∈ openSegment 𝕜 x y) (hxz : f z < f x) : f y < f z :=
  hf.dual.lt_right_of_left_lt hx hy hz hxz
#align concave_on.lt_right_of_left_lt ConcaveOn.lt_right_of_left_lt

end Module

end LinearOrderedCancelAddCommMonoid

section OrderedAddCommGroup

variable [OrderedAddCommGroup β] [SMul 𝕜 E] [Module 𝕜 β] {s : Set E} {f g : E → β}

/-- A function `-f` is convex iff `f` is concave. -/
@[simp]
theorem neg_convexOn_iff : ConvexOn 𝕜 s (-f) ↔ ConcaveOn 𝕜 s f :=
  by
  constructor
  · rintro ⟨hconv, h⟩
    refine' ⟨hconv, fun x hx y 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, fun x hx y 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
#align neg_convex_on_iff neg_convexOn_iff

/-- A function `-f` is concave iff `f` is convex. -/
@[simp]
theorem neg_concaveOn_iff : ConcaveOn 𝕜 s (-f) ↔ ConvexOn 𝕜 s f := by
  rw [← neg_convexOn_iff, neg_neg f]
#align neg_concave_on_iff neg_concaveOn_iff

/-- A function `-f` is strictly convex iff `f` is strictly concave. -/
@[simp]
theorem neg_strictConvexOn_iff : StrictConvexOn 𝕜 s (-f) ↔ StrictConcaveOn 𝕜 s f :=
  by
  constructor
  · rintro ⟨hconv, h⟩
    refine' ⟨hconv, fun x hx y 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, fun x hx y 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
#align neg_strict_convex_on_iff neg_strictConvexOn_iff

/-- A function `-f` is strictly concave iff `f` is strictly convex. -/
@[simp]
theorem neg_strictConcaveOn_iff : StrictConcaveOn 𝕜 s (-f) ↔ StrictConvexOn 𝕜 s f := by
  rw [← neg_strictConvexOn_iff, neg_neg f]
#align neg_strict_concave_on_iff neg_strictConcaveOn_iff

alias neg_convexOn_iff ↔ _ ConcaveOn.neg
#align concave_on.neg ConcaveOn.neg

alias neg_concaveOn_iff ↔ _ ConvexOn.neg
#align convex_on.neg ConvexOn.neg

alias neg_strictConvexOn_iff ↔ _ StrictConcaveOn.neg
#align strict_concave_on.neg StrictConcaveOn.neg

alias neg_strictConcaveOn_iff ↔ _ StrictConvexOn.neg
#align strict_convex_on.neg StrictConvexOn.neg

theorem ConvexOn.sub (hf : ConvexOn 𝕜 s f) (hg : ConcaveOn 𝕜 s g) : ConvexOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add hg.neg
#align convex_on.sub ConvexOn.sub

theorem ConcaveOn.sub (hf : ConcaveOn 𝕜 s f) (hg : ConvexOn 𝕜 s g) : ConcaveOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add hg.neg
#align concave_on.sub ConcaveOn.sub

theorem StrictConvexOn.sub (hf : StrictConvexOn 𝕜 s f) (hg : StrictConcaveOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add hg.neg
#align strict_convex_on.sub StrictConvexOn.sub

theorem StrictConcaveOn.sub (hf : StrictConcaveOn 𝕜 s f) (hg : StrictConvexOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add hg.neg
#align strict_concave_on.sub StrictConcaveOn.sub

theorem ConvexOn.sub_strictConcaveOn (hf : ConvexOn 𝕜 s f) (hg : StrictConcaveOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add_strictConvexOn hg.neg
#align convex_on.sub_strict_concave_on ConvexOn.sub_strictConcaveOn

theorem ConcaveOn.sub_strictConvexOn (hf : ConcaveOn 𝕜 s f) (hg : StrictConvexOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add_strictConcaveOn hg.neg
#align concave_on.sub_strict_convex_on ConcaveOn.sub_strictConvexOn

theorem StrictConvexOn.sub_concaveOn (hf : StrictConvexOn 𝕜 s f) (hg : ConcaveOn 𝕜 s g) :
    StrictConvexOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add_convexOn hg.neg
#align strict_convex_on.sub_concave_on StrictConvexOn.sub_concaveOn

theorem StrictConcaveOn.sub_convexOn (hf : StrictConcaveOn 𝕜 s f) (hg : ConvexOn 𝕜 s g) :
    StrictConcaveOn 𝕜 s (f - g) :=
  (sub_eq_add_neg f g).symm ▸ hf.add_concaveOn hg.neg
#align strict_concave_on.sub_convex_on StrictConcaveOn.sub_convexOn

end OrderedAddCommGroup

end AddCommMonoid

section AddCancelCommMonoid

variable [AddCancelCommMonoid E] [OrderedAddCommMonoid β] [Module 𝕜 E] [SMul 𝕜 β] {s : Set E}
  {f : E → β}

/-- Right translation preserves strict convexity. -/
theorem StrictConvexOn.translate_right (hf : StrictConvexOn 𝕜 s f) (c : E) :
    StrictConvexOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => c + z) :=
  ⟨hf.1.translate_preimage_right _, fun x hx y 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
      ⟩
#align strict_convex_on.translate_right StrictConvexOn.translate_right

/-- Right translation preserves strict concavity. -/
theorem StrictConcaveOn.translate_right (hf : StrictConcaveOn 𝕜 s f) (c : E) :
    StrictConcaveOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => c + z) :=
  hf.dual.translate_right _
#align strict_concave_on.translate_right StrictConcaveOn.translate_right

/-- Left translation preserves strict convexity. -/
theorem StrictConvexOn.translate_left (hf : StrictConvexOn 𝕜 s f) (c : E) :
    StrictConvexOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => z + c) := by
  simpa only [add_comm] using hf.translate_right _
#align strict_convex_on.translate_left StrictConvexOn.translate_left

/-- Left translation preserves strict concavity. -/
theorem StrictConcaveOn.translate_left (hf : StrictConcaveOn 𝕜 s f) (c : E) :
    StrictConcaveOn 𝕜 ((fun z => c + z) ⁻¹' s) (f ∘ fun z => z + c) := by
  simpa only [add_comm] using hf.translate_right _
#align strict_concave_on.translate_left StrictConcaveOn.translate_left

end AddCancelCommMonoid

end OrderedSemiring

section OrderedCommSemiring

variable [OrderedCommSemiring 𝕜] [AddCommMonoid E]

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid β]

section Module

variable [SMul 𝕜 E] [Module 𝕜 β] [OrderedSMul 𝕜 β] {s : Set E} {f : E → β}

theorem ConvexOn.smul {c : 𝕜} (hc : 0 ≤ c) (hf : ConvexOn 𝕜 s f) : ConvexOn 𝕜 s fun x => c • f x :=
  ⟨hf.1, fun x hx y 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] <;> infer_instance
      ⟩
#align convex_on.smul ConvexOn.smul

theorem ConcaveOn.smul {c : 𝕜} (hc : 0 ≤ c) (hf : ConcaveOn 𝕜 s f) :
    ConcaveOn 𝕜 s fun x => c • f x :=
  hf.dual.smul hc
#align concave_on.smul ConcaveOn.smul

end Module

end OrderedAddCommMonoid

end OrderedCommSemiring

section OrderedRing

variable [LinearOrderedField 𝕜] [AddCommGroup E] [AddCommGroup F]

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid β]

section Module

variable [Module 𝕜 E] [Module 𝕜 F] [SMul 𝕜 β]

/-- If a function is convex on `s`, it remains convex when precomposed by an affine map. -/
theorem ConvexOn.comp_affineMap {f : F → β} (g : E →ᵃ[𝕜] F) {s : Set F} (hf : ConvexOn 𝕜 s f) :
    ConvexOn 𝕜 (g ⁻¹' s) (f ∘ g) :=
  ⟨hf.1.affine_preimage _, fun x hx y 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
      ⟩
#align convex_on.comp_affine_map ConvexOn.comp_affineMap

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

end Module

end OrderedAddCommMonoid

end OrderedRing

section LinearOrderedField

variable [LinearOrderedField 𝕜] [AddCommMonoid E]

section OrderedAddCommMonoid

variable [OrderedAddCommMonoid β]

section SMul

variable [SMul 𝕜 E] [SMul 𝕜 β] {s : Set E}

theorem convexOn_iff_div {f : E → β} :
    ConvexOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              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
    ⟨by
      intro h x hx y 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'],
      by
      intro h x hx y hy a b ha hb hab
      simpa [hab, zero_lt_one] using h hx hy ha hb⟩
#align convex_on_iff_div convexOn_iff_div

theorem concaveOn_iff_div {f : E → β} :
    ConcaveOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              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) :=
  @convexOn_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _
#align concave_on_iff_div concaveOn_iff_div

theorem strictConvexOn_iff_div {f : E → β} :
    StrictConvexOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              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
    ⟨by
      intro h x hx y 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'],
      by
      intro h x hx y hy hxy a b ha hb hab
      simpa [hab, zero_lt_one] using h hx hy hxy ha hb⟩
#align strict_convex_on_iff_div strictConvexOn_iff_div

theorem strictConcaveOn_iff_div {f : E → β} :
    StrictConcaveOn 𝕜 s f ↔
      Convex 𝕜 s ∧
        ∀ ⦃x⦄,
          x ∈ s →
            ∀ ⦃y⦄,
              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) :=
  @strictConvexOn_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _
#align strict_concave_on_iff_div strictConcaveOn_iff_div

end SMul

end OrderedAddCommMonoid

end LinearOrderedField

section

variable [LinearOrderedField 𝕜] [LinearOrderedCancelAddCommMonoid β] [Module 𝕜 β] [OrderedSMul 𝕜 β]
  {x y z : 𝕜} {s : Set 𝕜} {f : 𝕜 → β}

theorem ConvexOn.le_right_of_left_le'' (hf : ConvexOn 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y)
    (hyz : y ≤ z) (h : f x ≤ f y) : f y ≤ f z :=
  hyz.eq_or_lt.elim (fun hyz => (congr_arg f hyz).le) fun hyz =>
    hf.le_right_of_left_le hx hz (Ioo_subset_openSegment ⟨hxy, hyz⟩) h
#align convex_on.le_right_of_left_le'' ConvexOn.le_right_of_left_le''

theorem ConvexOn.le_left_of_right_le'' (hf : ConvexOn 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) (hxy : x ≤ y)
    (hyz : y < z) (h : f z ≤ f y) : f y ≤ f x :=
  hxy.eq_or_lt.elim (fun hxy => (congr_arg f hxy).ge) fun hxy =>
    hf.le_left_of_right_le hx hz (Ioo_subset_openSegment ⟨hxy, hyz⟩) h
#align convex_on.le_left_of_right_le'' ConvexOn.le_left_of_right_le''

theorem ConcaveOn.right_le_of_le_left'' (hf : ConcaveOn 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s)
    (hxy : x < y) (hyz : y ≤ z) (h : f y ≤ f x) : f z ≤ f y :=
  hf.dual.le_right_of_left_le'' hx hz hxy hyz h
#align concave_on.right_le_of_le_left'' ConcaveOn.right_le_of_le_left''

theorem ConcaveOn.left_le_of_le_right'' (hf : ConcaveOn 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s)
    (hxy : x ≤ y) (hyz : y < z) (h : f y ≤ f z) : f x ≤ f y :=
  hf.dual.le_left_of_right_le'' hx hz hxy hyz h
#align concave_on.left_le_of_le_right'' ConcaveOn.left_le_of_le_right''

end


/-
Copyright (c) 2018 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.function.iterate
import Mathlib.topology.metric_space.basic
import Mathlib.category_theory.endomorphism
import Mathlib.category_theory.types
import Mathlib.PostPort

universes u v w x

namespace Mathlib

/-!
# Lipschitz continuous functions

A map `f : α → β` between two (extended) metric spaces is called *Lipschitz continuous*
with constant `K ≥ 0` if for all `x, y` we have `edist (f x) (f y) ≤ K * edist x y`.
For a metric space, the latter inequality is equivalent to `dist (f x) (f y) ≤ K * dist x y`.
There is also a version asserting this inequality only for `x` and `y` in some set `s`.

In this file we provide various ways to prove that various combinations of Lipschitz continuous
functions are Lipschitz continuous. We also prove that Lipschitz continuous functions are
uniformly continuous.

## Main definitions and lemmas

* `lipschitz_with K f`: states that `f` is Lipschitz with constant `K : ℝ≥0`
* `lipschitz_on_with K f`: states that `f` is Lipschitz with constant `K : ℝ≥0` on a set `s`
* `lipschitz_with.uniform_continuous`: a Lipschitz function is uniformly continuous
* `lipschitz_on_with.uniform_continuous_on`: a function which is Lipschitz on a set is uniformly
  continuous on that set.

## Implementation notes

The parameter `K` has type `ℝ≥0`. This way we avoid conjuction in the definition and have
coercions both to `ℝ` and `ennreal`. Constructors whose names end with `'` take `K : ℝ` as an
argument, and return `lipschitz_with (nnreal.of_real K) f`.
-/

/-- A function `f` is Lipschitz continuous with constant `K ≥ 0` if for all `x, y`
we have `dist (f x) (f y) ≤ K * dist x y` -/
def lipschitz_with {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (K : nnreal) (f : α → β) :=
  ∀ (x y : α), edist (f x) (f y) ≤ ↑K * edist x y

theorem lipschitz_with_iff_dist_le_mul {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} : lipschitz_with K f ↔ ∀ (x y : α), dist (f x) (f y) ≤ ↑K * dist x y := sorry

theorem lipschitz_with.dist_le_mul {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} : lipschitz_with K f → ∀ (x y : α), dist (f x) (f y) ≤ ↑K * dist x y :=
  iff.mp lipschitz_with_iff_dist_le_mul

/-- A function `f` is Lipschitz continuous with constant `K ≥ 0` on `s` if for all `x, y` in `s`
we have `dist (f x) (f y) ≤ K * dist x y` -/
def lipschitz_on_with {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (K : nnreal) (f : α → β) (s : set α) :=
  ∀ {x : α}, x ∈ s → ∀ {y : α}, y ∈ s → edist (f x) (f y) ≤ ↑K * edist x y

@[simp] theorem lipschitz_on_with_empty {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (K : nnreal) (f : α → β) : lipschitz_on_with K f ∅ :=
  fun (x : α) (x_in : x ∈ ∅) (y : α) (y_in : y ∈ ∅) => false.elim x_in

theorem lipschitz_on_with.mono {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {s : set α} {t : set α} {f : α → β} (hf : lipschitz_on_with K f t) (h : s ⊆ t) : lipschitz_on_with K f s :=
  fun (x : α) (x_in : x ∈ s) (y : α) (y_in : y ∈ s) => hf (h x_in) (h y_in)

theorem lipschitz_on_with_iff_dist_le_mul {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {s : set α} {f : α → β} : lipschitz_on_with K f s ↔ ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → dist (f x) (f y) ≤ ↑K * dist x y := sorry

theorem lipschitz_on_with.dist_le_mul {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {s : set α} {f : α → β} : lipschitz_on_with K f s → ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → dist (f x) (f y) ≤ ↑K * dist x y :=
  iff.mp lipschitz_on_with_iff_dist_le_mul

@[simp] theorem lipschitz_on_univ {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} : lipschitz_on_with K f set.univ ↔ lipschitz_with K f := sorry

theorem lipschitz_on_with_iff_restrict {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} {s : set α} : lipschitz_on_with K f s ↔ lipschitz_with K (set.restrict f s) := sorry

namespace lipschitz_with

theorem edist_le_mul {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (h : lipschitz_with K f) (x : α) (y : α) : edist (f x) (f y) ≤ ↑K * edist x y :=
  h x y

theorem edist_lt_top {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) {x : α} {y : α} (h : edist x y < ⊤) : edist (f x) (f y) < ⊤ :=
  lt_of_le_of_lt (hf x y) (ennreal.mul_lt_top ennreal.coe_lt_top h)

theorem mul_edist_le {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (h : lipschitz_with K f) (x : α) (y : α) : ↑K⁻¹ * edist (f x) (f y) ≤ edist x y := sorry

protected theorem of_edist_le {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {f : α → β} (h : ∀ (x y : α), edist (f x) (f y) ≤ edist x y) : lipschitz_with 1 f := sorry

protected theorem weaken {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) {K' : nnreal} (h : K ≤ K') : lipschitz_with K' f :=
  fun (x y : α) => le_trans (hf x y) (ennreal.mul_right_mono (iff.mpr ennreal.coe_le_coe h))

theorem ediam_image_le {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) (s : set α) : emetric.diam (f '' s) ≤ ↑K * emetric.diam s := sorry

/-- A Lipschitz function is uniformly continuous -/
protected theorem uniform_continuous {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) : uniform_continuous f := sorry

/-- A Lipschitz function is continuous -/
protected theorem continuous {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) : continuous f :=
  uniform_continuous.continuous (lipschitz_with.uniform_continuous hf)

protected theorem const {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (b : β) : lipschitz_with 0 fun (a : α) => b := sorry

protected theorem id {α : Type u} [emetric_space α] : lipschitz_with 1 id :=
  lipschitz_with.of_edist_le fun (x y : α) => le_refl (edist (id x) (id y))

protected theorem subtype_val {α : Type u} [emetric_space α] (s : set α) : lipschitz_with 1 subtype.val :=
  lipschitz_with.of_edist_le fun (x y : Subtype fun (x : α) => x ∈ s) => le_refl (edist (subtype.val x) (subtype.val y))

protected theorem subtype_coe {α : Type u} [emetric_space α] (s : set α) : lipschitz_with 1 coe :=
  lipschitz_with.subtype_val s

protected theorem restrict {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) (s : set α) : lipschitz_with K (set.restrict f s) :=
  fun (x y : ↥s) => hf ↑x ↑y

protected theorem comp {α : Type u} {β : Type v} {γ : Type w} [emetric_space α] [emetric_space β] [emetric_space γ] {Kf : nnreal} {Kg : nnreal} {f : β → γ} {g : α → β} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf * Kg) (f ∘ g) := sorry

protected theorem prod_fst {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] : lipschitz_with 1 prod.fst :=
  lipschitz_with.of_edist_le
    fun (x y : α × β) => le_max_left (edist (prod.fst x) (prod.fst y)) (edist (prod.snd x) (prod.snd y))

protected theorem prod_snd {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] : lipschitz_with 1 prod.snd :=
  lipschitz_with.of_edist_le
    fun (x y : α × β) => le_max_right (edist (prod.fst x) (prod.fst y)) (edist (prod.snd x) (prod.snd y))

protected theorem prod {α : Type u} {β : Type v} {γ : Type w} [emetric_space α] [emetric_space β] [emetric_space γ] {f : α → β} {Kf : nnreal} (hf : lipschitz_with Kf f) {g : α → γ} {Kg : nnreal} (hg : lipschitz_with Kg g) : lipschitz_with (max Kf Kg) fun (x : α) => (f x, g x) := sorry

protected theorem uncurry {α : Type u} {β : Type v} {γ : Type w} [emetric_space α] [emetric_space β] [emetric_space γ] {f : α → β → γ} {Kα : nnreal} {Kβ : nnreal} (hα : ∀ (b : β), lipschitz_with Kα fun (a : α) => f a b) (hβ : ∀ (a : α), lipschitz_with Kβ (f a)) : lipschitz_with (Kα + Kβ) (function.uncurry f) := sorry

protected theorem iterate {α : Type u} [emetric_space α] {K : nnreal} {f : α → α} (hf : lipschitz_with K f) (n : ℕ) : lipschitz_with (K ^ n) (nat.iterate f n) := sorry

theorem edist_iterate_succ_le_geometric {α : Type u} [emetric_space α] {K : nnreal} {f : α → α} (hf : lipschitz_with K f) (x : α) (n : ℕ) : edist (nat.iterate f n x) (nat.iterate f (n + 1) x) ≤ edist x (f x) * ↑K ^ n := sorry

protected theorem mul {α : Type u} [emetric_space α] {f : category_theory.End α} {g : category_theory.End α} {Kf : nnreal} {Kg : nnreal} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf * Kg) (f * g) :=
  lipschitz_with.comp hf hg

/-- The product of a list of Lipschitz continuous endomorphisms is a Lipschitz continuous
endomorphism. -/
protected theorem list_prod {α : Type u} {ι : Type x} [emetric_space α] (f : ι → category_theory.End α) (K : ι → nnreal) (h : ∀ (i : ι), lipschitz_with (K i) (f i)) (l : List ι) : lipschitz_with (list.prod (list.map K l)) (list.prod (list.map f l)) := sorry

protected theorem pow {α : Type u} [emetric_space α] {f : category_theory.End α} {K : nnreal} (h : lipschitz_with K f) (n : ℕ) : lipschitz_with (K ^ n) (f ^ n) := sorry

protected theorem of_dist_le' {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β} {K : ℝ} (h : ∀ (x y : α), dist (f x) (f y) ≤ K * dist x y) : lipschitz_with (nnreal.of_real K) f :=
  of_dist_le_mul fun (x y : α) => le_trans (h x y) (mul_le_mul_of_nonneg_right (nnreal.le_coe_of_real K) dist_nonneg)

protected theorem mk_one {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β} (h : ∀ (x y : α), dist (f x) (f y) ≤ dist x y) : lipschitz_with 1 f := sorry

/-- For functions to `ℝ`, it suffices to prove `f x ≤ f y + K * dist x y`; this version
doesn't assume `0≤K`. -/
protected theorem of_le_add_mul' {α : Type u} [metric_space α] {f : α → ℝ} (K : ℝ) (h : ∀ (x y : α), f x ≤ f y + K * dist x y) : lipschitz_with (nnreal.of_real K) f := sorry

/-- For functions to `ℝ`, it suffices to prove `f x ≤ f y + K * dist x y`; this version
assumes `0≤K`. -/
protected theorem of_le_add_mul {α : Type u} [metric_space α] {f : α → ℝ} (K : nnreal) (h : ∀ (x y : α), f x ≤ f y + ↑K * dist x y) : lipschitz_with K f := sorry

protected theorem of_le_add {α : Type u} [metric_space α] {f : α → ℝ} (h : ∀ (x y : α), f x ≤ f y + dist x y) : lipschitz_with 1 f := sorry

protected theorem le_add_mul {α : Type u} [metric_space α] {f : α → ℝ} {K : nnreal} (h : lipschitz_with K f) (x : α) (y : α) : f x ≤ f y + ↑K * dist x y :=
  iff.mp sub_le_iff_le_add' (le_trans (le_abs_self (f x - f y)) (dist_le_mul h x y))

protected theorem iff_le_add_mul {α : Type u} [metric_space α] {f : α → ℝ} {K : nnreal} : lipschitz_with K f ↔ ∀ (x y : α), f x ≤ f y + ↑K * dist x y :=
  { mp := lipschitz_with.le_add_mul, mpr := lipschitz_with.of_le_add_mul K }

theorem nndist_le {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) (x : α) (y : α) : nndist (f x) (f y) ≤ K * nndist x y :=
  dist_le_mul hf x y

theorem diam_image_le {α : Type u} {β : Type v} [metric_space α] [metric_space β] {K : nnreal} {f : α → β} (hf : lipschitz_with K f) (s : set α) (hs : metric.bounded s) : metric.diam (f '' s) ≤ ↑K * metric.diam s := sorry

protected theorem dist_left {α : Type u} [metric_space α] (y : α) : lipschitz_with 1 fun (x : α) => dist x y := sorry

protected theorem dist_right {α : Type u} [metric_space α] (x : α) : lipschitz_with 1 (dist x) :=
  lipschitz_with.of_le_add fun (y z : α) => dist_triangle_right x y z

protected theorem dist {α : Type u} [metric_space α] : lipschitz_with (bit0 1) (function.uncurry dist) :=
  lipschitz_with.uncurry lipschitz_with.dist_left lipschitz_with.dist_right

theorem dist_iterate_succ_le_geometric {α : Type u} [metric_space α] {K : nnreal} {f : α → α} (hf : lipschitz_with K f) (x : α) (n : ℕ) : dist (nat.iterate f n x) (nat.iterate f (n + 1) x) ≤ dist x (f x) * ↑K ^ n := sorry

end lipschitz_with

namespace lipschitz_on_with

protected theorem uniform_continuous_on {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {s : set α} {f : α → β} (hf : lipschitz_on_with K f s) : uniform_continuous_on f s :=
  iff.mpr uniform_continuous_on_iff_restrict
    (lipschitz_with.uniform_continuous (iff.mp lipschitz_on_with_iff_restrict hf))

protected theorem continuous_on {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {K : nnreal} {s : set α} {f : α → β} (hf : lipschitz_on_with K f s) : continuous_on f s :=
  uniform_continuous_on.continuous_on (lipschitz_on_with.uniform_continuous_on hf)

end lipschitz_on_with

/-- If a function is locally Lipschitz around a point, then it is continuous at this point. -/
theorem continuous_at_of_locally_lipschitz {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β} {x : α} {r : ℝ} (hr : 0 < r) (K : ℝ) (h : ∀ (y : α), dist y x < r → dist (f y) (f x) ≤ K * dist y x) : continuous_at f x := sorry


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.sqrt
import Mathlib.data.zsqrtd.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Image of `zsqrtd` in `ℝ`

This file defines `zsqrtd.to_real` and related lemmas.
It is in a separate file to avoid pulling in all of `data.real` into `data.zsqrtd`.
-/

namespace zsqrtd

/-- The image of `zsqrtd` in `ℝ`, using `real.sqrt` which takes the positive root of `d`.

If the negative root is desired, use `to_real h a.conj`. -/
@[simp] theorem to_real_apply {d : ℤ} (h : 0 ≤ d) (a : ℤ√d) :
    coe_fn (to_real h) a = ↑(re a) + ↑(im a) * real.sqrt ↑d :=
  Eq.refl (↑(re a) + ↑(im a) * real.sqrt ↑d)

theorem to_real_injective {d : ℤ} (h0d : 0 ≤ d) (hd : ∀ (n : ℤ), d ≠ n * n) :
    function.injective ⇑(to_real h0d) :=
  lift_injective { val := real.sqrt ↑d, property := to_real._proof_1 h0d } hd

end Mathlib


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import data.set.Union_lift
import topology.homeomorph

/-!
# Continuous bundled map

In this file we define the type `continuous_map` of continuous bundled maps.
-/

/-- Bundled continuous maps. -/
@[protect_proj]
structure continuous_map (α : Type*) (β : Type*)
[topological_space α] [topological_space β] :=
(to_fun             : α → β)
(continuous_to_fun  : continuous to_fun . tactic.interactive.continuity')

notation `C(` α `, ` β `)` := continuous_map α β

namespace continuous_map

attribute [continuity] continuous_map.continuous_to_fun

variables {α : Type*} {β : Type*} {γ : Type*}
variables [topological_space α] [topological_space β] [topological_space γ]

instance : has_coe_to_fun (C(α, β)) (λ _, α → β) := ⟨continuous_map.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : C(α, β)} : f.to_fun = (f : α → β) := rfl

variables {α β} {f g : continuous_map α β}

@[continuity] protected lemma continuous (f : C(α, β)) : continuous f := f.continuous_to_fun
@[continuity] lemma continuous_set_coe (s : set C(α, β)) (f : s) : continuous f :=
by { cases f, rw @coe_fn_coe_base', continuity }

protected lemma continuous_at (f : C(α, β)) (x : α) : continuous_at f x :=
f.continuous.continuous_at

protected lemma continuous_within_at (f : C(α, β)) (s : set α) (x : α) :
  continuous_within_at f s x :=
f.continuous.continuous_within_at

protected lemma congr_fun {f g : C(α, β)} (H : f = g) (x : α) : f x = g x := H ▸ rfl
protected lemma congr_arg (f : C(α, β)) {x y : α} (h : x = y) : f x = f y := h ▸ rfl

@[ext]

lemma ext_iff : f = g ↔ ∀ x, f x = g x :=
⟨continuous_map.congr_fun, ext⟩

instance [inhabited β] : inhabited C(α, β) :=
⟨{ to_fun := λ _, default, }⟩

lemma coe_inj ⦃f g : C(α, β)⦄ (h : (f : α → β) = g) : f = g :=
by cases f; cases g; cases h; refl

@[simp] lemma coe_mk (f : α → β) (h : continuous f) :
  ⇑(⟨f, h⟩ : continuous_map α β) = f := rfl

section
variables (α β)

/--
The continuous functions from `α` to `β` are the same as the plain functions when `α` is discrete.
-/
@[simps]
def equiv_fn_of_discrete [discrete_topology α] : C(α, β) ≃ (α → β) :=
⟨(λ f, f), (λ f, ⟨f, continuous_of_discrete_topology⟩),
  λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

end

/-- The identity as a continuous map. -/
def id : C(α, α) := ⟨id⟩

@[simp] lemma id_coe : (id : α → α) = _root_.id := rfl
lemma id_apply (a : α) : id a = a := rfl

/-- The composition of continuous maps, as a continuous map. -/
def comp (f : C(β, γ)) (g : C(α, β)) : C(α, γ) := ⟨f ∘ g⟩

@[simp] lemma comp_coe (f : C(β, γ)) (g : C(α, β)) : (comp f g : α → γ) = f ∘ g := rfl
lemma comp_apply (f : C(β, γ)) (g : C(α, β)) (a : α) : comp f g a = f (g a) := rfl

@[simp] lemma id_comp (f : C(β, γ)) : id.comp f = f := by { ext, refl }
@[simp] lemma comp_id (f : C(α, β)) : f.comp id = f := by { ext, refl }

/-- Constant map as a continuous map -/
def const (b : β) : C(α, β) := ⟨λ x, b⟩

@[simp] lemma const_coe (b : β) : (const b : α → β) = (λ x, b) := rfl
lemma const_apply (b : β) (a : α) : const b a = b := rfl

instance [h : nonempty α] [nontrivial β] : nontrivial C(α, β) :=
{ exists_pair_ne := begin
    obtain ⟨b₁, b₂, hb⟩ := exists_pair_ne β,
    refine ⟨const b₁, const b₂, _⟩,
    contrapose! hb,
    change const b₁ h.some = const b₂ h.some,
    simp [hb]
  end }

section prod

variables {α₁ α₂ β₁ β₂ : Type*}
          [topological_space α₁] [topological_space α₂]
          [topological_space β₁] [topological_space β₂]

/-- Given two continuous maps `f` and `g`, this is the continuous map `x ↦ (f x, g x)`. -/
def prod_mk (f : C(α, β₁)) (g : C(α, β₂)) :
  C(α, β₁ × β₂) :=
{ to_fun := (λ x, (f x, g x)),
  continuous_to_fun := continuous.prod_mk f.continuous g.continuous }

/-- Given two continuous maps `f` and `g`, this is the continuous map `(x, y) ↦ (f x, g y)`. -/
def prod_map (f : C(α₁, α₂)) (g : C(β₁, β₂)) :
  C(α₁ × β₁, α₂ × β₂) :=
{ to_fun := prod.map f g,
  continuous_to_fun := continuous.prod_map f.continuous g.continuous }

@[simp] lemma prod_eval (f : C(α, β₁)) (g : C(α, β₂)) (a : α) :
  (prod_mk f g) a = (f a, g a) := rfl

end prod

section pi

variables {I A : Type*} {X : I → Type*}
          [topological_space A] [∀ i, topological_space (X i)]

/-- Abbreviation for product of continuous maps, which is continuous -/
def pi (f : Π i, C(A, X i)) : C(A, Π i, X i) :=
{ to_fun := λ (a : A) (i : I), f i a, }

@[simp] lemma pi_eval (f : Π i, C(A, X i)) (a : A) :
  (pi f) a = λ i : I, (f i) a := rfl

end pi

section restrict

variables (s : set α)

/-- The restriction of a continuous function `α → β` to a subset `s` of `α`. -/
def restrict (f : C(α, β)) : C(s, β) := ⟨f ∘ coe⟩

@[simp] lemma coe_restrict (f : C(α, β)) : ⇑(f.restrict s) = f ∘ coe := rfl

end restrict

section gluing

variables {ι : Type*}
  (S : ι → set α)
  (φ : Π i : ι, C(S i, β))
  (hφ : ∀ i j (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), φ i ⟨x, hxi⟩ = φ j ⟨x, hxj⟩)
  (hS : ∀ x : α, ∃ i, S i ∈ nhds x)

include hφ hS

/-- A family `φ i` of continuous maps `C(S i, β)`, where the domains `S i` contain a neighbourhood
of each point in `α` and the functions `φ i` agree pairwise on intersections, can be glued to
construct a continuous map in `C(α, β)`. -/
noncomputable def lift_cover : C(α, β) :=
begin
  have H : (⋃ i, S i) = set.univ,
  { rw set.eq_univ_iff_forall,
    intros x,
    rw set.mem_Union,
    obtain ⟨i, hi⟩ := hS x,
    exact ⟨i, mem_of_mem_nhds hi⟩ },
  refine ⟨set.lift_cover S (λ i, φ i) hφ H, continuous_subtype_nhds_cover hS _⟩,
  intros i,
  convert (φ i).continuous,
  ext x,
  exact set.lift_cover_coe x,
end

variables {S φ hφ hS}

@[simp] lemma lift_cover_coe {i : ι} (x : S i) : lift_cover S φ hφ hS x = φ i x :=
set.lift_cover_coe _

@[simp] lemma lift_cover_restrict {i : ι} : (lift_cover S φ hφ hS).restrict (S i) = φ i :=
ext $ lift_cover_coe

omit hφ hS

variables (A : set (set α))
  (F : Π (s : set α) (hi : s ∈ A), C(s, β))
  (hF : ∀ s (hs : s ∈ A) t (ht : t ∈ A) (x : α) (hxi : x ∈ s) (hxj : x ∈ t),
    F s hs ⟨x, hxi⟩ = F t ht ⟨x, hxj⟩)
  (hA : ∀ x : α, ∃ i ∈ A, i ∈ nhds x)

include hF hA

/-- A family `F s` of continuous maps `C(s, β)`, where (1) the domains `s` are taken from a set `A`
of sets in `α` which contain a neighbourhood of each point in `α` and (2) the functions `F s` agree
pairwise on intersections, can be glued to construct a continuous map in `C(α, β)`. -/
noncomputable def lift_cover' : C(α, β) :=
begin
  let S : A → set α := coe,
  let F : Π i : A, C(i, β) := λ i, F i i.prop,
  refine lift_cover S F (λ i j, hF i i.prop j j.prop) _,
  intros x,
  obtain ⟨s, hs, hsx⟩ := hA x,
  exact ⟨⟨s, hs⟩, hsx⟩
end

variables {A F hF hA}

@[simp] lemma lift_cover_coe' {s : set α} {hs : s ∈ A} (x : s) :
  lift_cover' A F hF hA x = F s hs x :=
let x' : (coe : A → set α) ⟨s, hs⟩ := x in lift_cover_coe x'

@[simp] lemma lift_cover_restrict' {s : set α} {hs : s ∈ A} :
  (lift_cover' A F hF hA).restrict s = F s hs :=
ext $ lift_cover_coe'

end gluing

end continuous_map

/--
The forward direction of a homeomorphism, as a bundled continuous map.
-/
@[simps]
def homeomorph.to_continuous_map {α β : Type*} [topological_space α] [topological_space β]
  (e : α ≃ₜ β) : C(α, β) := ⟨e⟩


import chess.move.legal

/-!

"Proof" of Guarini's Problem: swapping some knights.

Given a board like:

    ♞ _ ♞
    _ _ _
    ♘ _ ♘

Guarini's problem asks for a sequence of moves that swaps the knights,
producing:

    ♘ _ ♘
    _ _ _
    ♞ _ ♞

Solution:

    ♞ _ ♞     ♞ _ ♞     ♞ _ _     ♞ _ ♘     _ _ ♘
    _ _ _  →  ♘ _ _  →  ♘ _ _  →  _ _ _  →  _ _ ♞
    ♘ _ ♘     ♘ _ _     ♘ ♞ _     ♘ ♞ _     ♘ ♞ _

              _ ♘ ♘     _ _ ♘     _ _ ♘     _ _ ♘
           →  _ _ ♞  →  _ _ ♞  →  ♘ _ ♞  →  ♘ _ _
              _ ♞ _     _ ♞ ♘     _ ♞ _     ♞ ♞ _

              _ ♞ ♘     ♞ ♞ ♘     _ ♞ ♘     _ ♞ _
           →  ♘ _ _  →  ♘ _ _  →  ♘ _ ♞  →  ♘ _ ♞
              _ ♞ _     _ _ _     _ _ _     _ ♘ _

              ♘ ♞ _     ♘ ♞ ♘     ♘ ♞ ♘     ♘ _ ♘
           →  ♘ _ ♞  →  _ _ ♞  →  _ _ _  →  _ _ _
              _ _ _     _ _ _     ♞ _ _     ♞ _ ♞

-/

def starting_position : chess.board _ _ _ _ := {
  pieces := ![♞, ♞, ♘, ♘],
  contents := PF ![
    ![(0 : fin 4), __, (1 : fin 4)],
    ![    __,      __,       __   ],
    ![(2 : fin 4), __, (3 : fin 4)]
  ],
}

def ending_position : chess.board _ _ _ _ := {
  starting_position with
  pieces := ![♘, ♘, ♞, ♞],
}

-- Direct solution

def guarini_seq : chess.move.sequence.legal :=
{ start_board := starting_position,
  elements := ![
  ((2, 0), (0, 1)),
  ((2, 2), (1, 0)),
  ((0, 1), (2, 2)),
  ((0, 2), (2, 1)),
  ((0, 0), (1, 2)),
  ((1, 2), (2, 0)),
  ((2, 0), (0, 1)),
  ((2, 1), (0, 0)),
  ((0, 0), (1, 2)),
  ((1, 0), (0, 2)),
  ((0, 2), (2, 1)),
  ((2, 2), (1, 0)),
  ((1, 0), (0, 2)),
  ((0, 1), (2, 2)),
  ((2, 1), (0, 0)),
  ((1, 2), (2, 0))] }

def first_move : chess.move starting_position :=
let pair := guarini_seq.elements 0 in ⟨pair.fst, pair.snd, dec_trivial, dec_trivial⟩

example : guarini_seq.to_sequence.boards 0 ≈ guarini_seq.start_board := dec_trivial

example : guarini_seq.to_sequence.boards 1 ≈ first_move.perform_move := dec_trivial

example : ∀ ix, (guarini_seq.elements ix).fst ≠ (guarini_seq.elements ix).snd := dec_trivial

lemma guarini : starting_position.has_sequence_to ending_position :=
⟨_, guarini_seq.to_sequence, dec_trivial⟩

-- Graph-equivalence


import data.nat.basic

variables (w x y z : ℕ) (p : ℕ → Prop)

local attribute [simp] mul_comm mul_assoc mul_left_comm
local attribute [simp] add_assoc add_comm add_left_comm

example (h : p (x * y + z * w * x)) : p (x * w * z + y * x) :=
by { simp at *, assumption }

example (h₁ : p (1 * x + y)) (h₂ : p (x * z * 1)) :
  p (y + 0 + x) ∧ p (z * x) :=
by { simp at *, split; assumption}

example : x * y + z * w * x = x * w * z + y * x :=
by simp

example (h : p (x * y + z * w * x)) : p (x * w * z + y * x) :=
begin
  simp, simp at h, assumption,
end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import data.rbtree.find
import data.rbtree.insert
import data.rbtree.min_max

universes u

namespace rbnode
variables {α : Type u} {lt : α → α → Prop}

lemma is_searchable_of_well_formed {t : rbnode α} [is_strict_weak_order α lt] :
  t.well_formed lt → is_searchable lt t none none :=
begin
  intro h, induction h,
  { constructor, simp [lift] },
  { subst h_n', apply is_searchable_insert, assumption }
end

open color

lemma is_red_black_of_well_formed {t : rbnode α} : t.well_formed lt → ∃ c n, is_red_black t c n :=
begin
  intro h, induction h,
  { existsi black, existsi 0, constructor },
  { cases h_ih with c ih, cases ih with n ih, subst h_n', apply insert_is_red_black, assumption }
end

end rbnode

namespace rbtree
variables {α : Type u} {lt : α → α → Prop}

lemma balanced (t : rbtree α lt) : t.depth max ≤ 2 * t.depth min + 1 :=
begin
  cases t with n p, simp only [depth],
  have := rbnode.is_red_black_of_well_formed p,
  cases this with _ this, cases this with _ this,
  apply rbnode.balanced, assumption
end

lemma not_mem_mk_rbtree : ∀ (a : α), a ∉ mk_rbtree α lt :=
by simp [has_mem.mem, rbtree.mem, rbnode.mem, mk_rbtree]

lemma not_mem_of_empty {t : rbtree α lt} (a : α) : t.empty = tt → a ∉ t :=
by cases t with n p; cases n; simp [empty, has_mem.mem, rbtree.mem, rbnode.mem, false_implies_iff]

lemma mem_of_mem_of_eqv [is_strict_weak_order α lt] {t : rbtree α lt} {a b : α} :
  a ∈ t → a ≈[lt] b → b ∈ t :=
begin
  cases t with n p; simp [has_mem.mem, rbtree.mem]; clear p; induction n;
    simp only [rbnode.mem, strict_weak_order.equiv, false_implies_iff]; intros h₁ h₂; blast_disjs,
  iterate 2
  { { have : rbnode.mem lt b n_lchild := n_ih_lchild h₁ h₂, simp [this] },
    { simp [incomp_trans_of lt h₂.swap h₁] },
    { have : rbnode.mem lt b n_rchild := n_ih_rchild h₁ h₂, simp [this] } }
end

section dec

variables [decidable_rel lt]

lemma insert_ne_mk_rbtree (t : rbtree α lt) (a : α) : t.insert a ≠ mk_rbtree α lt :=
begin
  cases t with n p, simp [insert, mk_rbtree], intro h, injection h with h',
  apply rbnode.insert_ne_leaf lt n a h'
end

lemma find_correct [is_strict_weak_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ (∃ b, t.find a = some b ∧ a ≈[lt] b) :=
begin cases t, apply rbnode.find_correct, apply rbnode.is_searchable_of_well_formed, assumption end

lemma find_correct_of_total [is_strict_total_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ t.find a = some a :=
iff.intro
  (λ h, match iff.mp (find_correct a t) h with
        | ⟨b, heq, heqv⟩ := by simp [heq, (eq_of_eqv_lt heqv).symm]
        end)
  (λ h, iff.mpr (find_correct a t) ⟨a, ⟨h, refl a⟩⟩)

lemma find_correct_exact [is_strict_total_order α lt] (a : α) (t : rbtree α lt) :
  mem_exact a t ↔ t.find a = some a :=
begin
  cases t, apply rbnode.find_correct_exact, apply rbnode.is_searchable_of_well_formed, assumption
end

lemma find_insert_of_eqv [is_strict_weak_order α lt] (t : rbtree α lt) {x y} :
  x ≈[lt] y → (t.insert x).find y = some x :=
begin
  cases t, intro h, apply rbnode.find_insert_of_eqv lt h, apply rbnode.is_searchable_of_well_formed,
  assumption
end

lemma find_insert [is_strict_weak_order α lt] (t : rbtree α lt) (x) :
  (t.insert x).find x = some x :=
find_insert_of_eqv t (refl x)

lemma find_insert_of_disj [is_strict_weak_order α lt] {x y : α} (t : rbtree α lt) :
  lt x y ∨ lt y x → (t.insert x).find y = t.find y :=
begin
  cases t, intro h, apply rbnode.find_insert_of_disj lt h,
  apply rbnode.is_searchable_of_well_formed,
  assumption
end

lemma find_insert_of_not_eqv [is_strict_weak_order α lt] {x y : α} (t : rbtree α lt) :
  ¬ x ≈[lt] y → (t.insert x).find y = t.find y :=
begin
  cases t, intro h, apply rbnode.find_insert_of_not_eqv lt h,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma find_insert_of_ne [is_strict_total_order α lt] {x y : α} (t : rbtree α lt) :
  x ≠ y → (t.insert x).find y = t.find y :=
begin
  cases t, intro h,
  have : ¬ x ≈[lt] y := λ h', h (eq_of_eqv_lt h'),
  apply rbnode.find_insert_of_not_eqv lt this,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma not_mem_of_find_none [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.find a = none → a ∉ t :=
λ h, iff.mpr (not_iff_not_of_iff (find_correct a t)) $
  begin
    intro h,
    cases h with _ h, cases h with h₁ h₂,
    rw [h] at h₁, contradiction
  end

lemma eqv_of_find_some [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
  t.find a = some b → a ≈[lt] b :=
begin
  cases t, apply rbnode.eqv_of_find_some, apply rbnode.is_searchable_of_well_formed, assumption
end

lemma eq_of_find_some [is_strict_total_order α lt] {a b : α} {t : rbtree α lt} :
  t.find a = some b → a = b :=
λ h, suffices a ≈[lt] b, from eq_of_eqv_lt this,
     eqv_of_find_some h

lemma find_eq_find_of_eqv [is_strict_weak_order α lt] {a b : α} (t : rbtree α lt) :
  a ≈[lt] b → t.find a = t.find b :=
begin
  cases t, apply rbnode.find_eq_find_of_eqv,
  apply rbnode.is_searchable_of_well_formed, assumption
end

lemma contains_correct [is_strict_weak_order α lt] (a : α) (t : rbtree α lt) :
  a ∈ t ↔ (t.contains a = tt) :=
begin
  have h := find_correct a t,
  simp [h, contains], apply iff.intro,
  { intro h', cases h' with _ h', cases h', simp [*], simp [option.is_some] },
  { intro h',
    cases heq : find t a with v, simp [heq, option.is_some] at h', contradiction,
    existsi v, simp, apply eqv_of_find_some heq }
end

lemma mem_insert_of_incomp {a b : α} (t : rbtree α lt) : (¬ lt a b ∧ ¬ lt b a) → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_incomp end

lemma mem_insert [is_irrefl α lt] : ∀ (a : α) (t : rbtree α lt), a ∈ t.insert a :=
begin intros, apply mem_insert_of_incomp, split; apply irrefl_of lt end

lemma mem_insert_of_equiv {a b : α} (t : rbtree α lt) : a ≈[lt] b → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_incomp end

lemma mem_insert_of_mem [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} (b : α) :
  a ∈ t → a ∈ t.insert b :=
begin cases t, apply rbnode.mem_insert_of_mem end

lemma equiv_or_mem_of_mem_insert [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → a ≈[lt] b ∨ a ∈ t :=
begin cases t, apply rbnode.equiv_or_mem_of_mem_insert end

lemma incomp_or_mem_of_mem_ins [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → (¬ lt a b ∧ ¬ lt b a) ∨ a ∈ t :=
equiv_or_mem_of_mem_insert

lemma eq_or_mem_of_mem_ins [is_strict_total_order α lt] {a b : α} {t : rbtree α lt} :
  a ∈ t.insert b → a = b ∨ a ∈ t :=
λ h, suffices a ≈[lt] b ∨ a ∈ t, by simp [eqv_lt_iff_eq] at this; assumption,
  incomp_or_mem_of_mem_ins h

end dec

lemma mem_of_min_eq [is_irrefl α lt] {a : α} {t : rbtree α lt} : t.min = some a → a ∈ t :=
begin cases t, apply rbnode.mem_of_min_eq end

lemma mem_of_max_eq [is_irrefl α lt] {a : α} {t : rbtree α lt} : t.max = some a → a ∈ t :=
begin cases t, apply rbnode.mem_of_max_eq end

lemma eq_leaf_of_min_eq_none {t : rbtree α lt} :
  t.min = none → t = mk_rbtree α lt :=
begin cases t, intro h, congr, apply rbnode.eq_leaf_of_min_eq_none h end

lemma eq_leaf_of_max_eq_none {t : rbtree α lt} :
  t.max = none → t = mk_rbtree α lt :=
begin cases t, intro h, congr, apply rbnode.eq_leaf_of_max_eq_none h end

lemma min_is_minimal [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.min = some a → ∀ {b}, b ∈ t → a ≈[lt] b ∨ lt a b :=
by { classical, cases t, apply rbnode.min_is_minimal, apply rbnode.is_searchable_of_well_formed,
  assumption }

lemma max_is_maximal [is_strict_weak_order α lt] {a : α} {t : rbtree α lt} :
  t.max = some a → ∀ {b}, b ∈ t → a ≈[lt] b ∨ lt b a :=
by { cases t, apply rbnode.max_is_maximal, apply rbnode.is_searchable_of_well_formed, assumption }

end rbtree


variables (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  exists.elim h
    (assume w,
      assume hw : p w ∧ q w,
      show ∃ x, q x ∧ p x, from ⟨w, hw.right, hw.left⟩)


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic
import .identity
import .congruence
import .model

namespace universal
universe u
variables {τ : Type} {σ : Type u} {sig : signature τ σ} {ι : Type} (ax : ι → identity sig)

inductive proof {ι : Type} (ax : ι → identity sig) {dom : list τ} : Π {cod : τ}, term sig dom cod → term sig dom cod → Type u
| ax (i : ι) (sub : substitution sig (ax i).dom dom) : proof (sub.apply (ax i).lhs) (sub.apply (ax i).rhs)
| proj {} (i : index dom) : proof (term.proj i) (term.proj i)
| func (f : σ) {lhs rhs : Π (i : sig.index f), term sig dom i.val} : (Π i, proof (lhs i) (rhs i)) → proof (term.func f lhs) (term.func f rhs)
| eucl {cod : τ} {{t u v : term sig dom cod}} : proof t u → proof t v → proof u v

namespace proof
variables {ax} {dom : list τ}

definition refl : Π {cod} (t : term sig dom cod), proof ax t t
| _ (term.proj i) := proof.proj i
| _ (term.func f ts) := proof.func f (λ i, refl (ts i))

definition rfl {cod} {t : term sig dom cod} : proof ax t t := proof.refl t

definition symm {cod} {{t u : term sig dom cod}} : proof ax t u → proof ax u t :=
λ h, proof.eucl h $ proof.refl t

definition trans {cod} {{t u v : term sig dom cod}} :
proof ax t u → proof ax u v → proof ax t v :=
λ h₁ h₂, proof.eucl h₁.symm h₂

definition subst {dom₁ dom₂ : list τ} (sub : substitution sig dom₁ dom₂) :
Π {cod : τ} {t u : term sig dom₁ cod}, proof ax t u → proof ax (sub.apply t) (sub.apply u)
| _ _ _ (proof.ax i isub) :=
  eq.rec_on (substitution.comp_apply sub isub (ax i).lhs) $
  eq.rec_on (substitution.comp_apply sub isub (ax i).rhs) $
  proof.ax i (substitution.comp sub isub)
| _ _ _ (proof.proj i) := proof.rfl
| _ _ _ (proof.func f hs) := proof.func f (λ i, subst (hs i))
| _ _ _ (proof.eucl h₁ h₂) := proof.eucl (subst h₁) (subst h₂)

definition ax_id (i) : proof ax (ax i).lhs (ax i).rhs :=
eq.rec_on (substitution.id_apply (ax i).lhs) $
eq.rec_on (substitution.id_apply (ax i).rhs) $
proof.ax i substitution.id

variables (sig dom ax)

definition to_congruence : congruence (term_algebra sig dom) :=
{ r := λ _ t u, nonempty (proof ax t u)
, refl := λ _ _, ⟨proof.rfl⟩
, eucl := λ _ _ _ _ ⟨h₁⟩ ⟨h₂⟩, ⟨proof.eucl h₁ h₂⟩
, func := λ f _ _ h, nonempty.elim (index.choice h) (λ h, ⟨proof.func f h⟩)
}

end proof

theorem proof.sound {dom} : ∀ {cod} {t u : term sig dom cod}, proof ax t u → valid ax t u
| _ _ _ (proof.ax i sub) := valid.ax i sub
| _ _ _ (proof.proj i) := valid.refl (term.proj i)
| _ _ _ (proof.func f hs) := valid.app f (λ i, proof.sound (hs i))
| _ _ _ (proof.eucl h₁ h₂) := valid.eucl (proof.sound h₁) (proof.sound h₂)

definition proves (e : identity sig) : Prop := nonempty (proof ax e.lhs e.rhs)

theorem soundness (e : identity sig) : proves ax e → models ax e := λ ⟨h⟩, proof.sound ax h

abbreviation init_algebra (dom : list τ) : algebra sig := quotient (term_algebra sig dom) (proof.to_congruence sig ax dom)

namespace init_algebra

theorem satisfies_exact (e : identity sig) :
(init_algebra ax e.dom).satisfies e → proves ax e :=
begin
rw ← quotient.satisfies,
intro H,
cases H substitution.id with H,
rw ← substitution.apply_def substitution.id at H,
rw ← substitution.apply_def substitution.id at H,
rw substitution.id_apply at H,
rw substitution.id_apply at H,
exact ⟨H⟩,
end

theorem satisfies_axiom (dom) (i) : algebra.satisfies (init_algebra ax dom) (ax i) :=
begin
rw ← quotient.satisfies (proof.to_congruence sig ax dom) (ax i),
intro sub,
apply nonempty.intro,
exact proof.ax i sub,
end

end init_algebra

theorem completeness (e : identity sig) : models ax e → proves ax e :=
begin
intro H,
apply init_algebra.satisfies_exact,
apply H,
apply init_algebra.satisfies_axiom,
end

end universal