/-
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_smul
variables (𝕜) [has_smul 𝕜 E] [has_smul 𝕜 β] (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_smul

section distrib_mul_action
variables [has_smul 𝕜 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_smul 𝕜 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_smul 𝕜 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_smul 𝕜 β] {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_smul 𝕜 β]

/-- 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_smul 𝕜 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_smul 𝕜 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_smul 𝕜 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.right_le_of_le_left' (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.right_le_of_le_left (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_smul 𝕜 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_smul 𝕜 β]
  {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_smul 𝕜 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_smul 𝕜 β]

/-- 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_smul
variables [has_smul 𝕜 E] [has_smul 𝕜 β] {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_smul
end ordered_add_comm_monoid
end linear_ordered_field

section

variables [linear_ordered_field 𝕜] [linear_ordered_cancel_add_comm_monoid β] [module 𝕜 β]
  [ordered_smul 𝕜 β] {x y z : 𝕜} {s : set 𝕜} {f : 𝕜 → β}

lemma convex_on.le_right_of_left_le'' (hf : convex_on 𝕜 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 (λ hyz, (congr_arg f hyz).le)
  (λ hyz, hf.le_right_of_left_le hx hz (Ioo_subset_open_segment ⟨hxy, hyz⟩) h)

lemma convex_on.le_left_of_right_le'' (hf : convex_on 𝕜 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 (λ hxy, (congr_arg f hxy).ge)
  (λ hxy, hf.le_left_of_right_le hx hz (Ioo_subset_open_segment ⟨hxy, hyz⟩) h)

lemma concave_on.right_le_of_le_left'' (hf : concave_on 𝕜 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

lemma concave_on.left_le_of_le_right'' (hf : concave_on 𝕜 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

end


import .deduct
import .function_update_ite

set_option pp.parens true

open formula

def formula.is_atomic : formula → Prop
| (true_) := false
| (pred_ name args) := true
| (eq_ x y) := true
| (not_ P) := false
| (imp_ P Q) := false
| (forall_ x P) := true

def formula.atomic_set : formula → finset formula
| (true_) := ∅
| (pred_ name args) := {pred_ name args}
| (eq_ x y) := {eq_ x y}
| (not_ P) := P.atomic_set
| (imp_ P Q) := P.atomic_set ∪ Q.atomic_set
| (forall_ x P) := {forall_ x P}

def formula.subst_atomic (σ : formula → formula) : formula → formula
| (true_) := true_
| (pred_ name args) := σ (pred_ name args)
| (eq_ x y) := σ (eq_ x y)
| (not_ P) := not_ P.subst_atomic
| (imp_ P Q) := imp_ P.subst_atomic Q.subst_atomic
| (forall_ x P) := σ (forall_ x P)

@[derive inhabited]
def valuation : Type := formula → bool

def formula.eval_atomic (val : valuation) : formula → bool
| (true_) := bool.tt
| (pred_ name args) := val (pred_ name args)
| (eq_ x y) := val (eq_ x y)
| (not_ P) := ! P.eval_atomic
| (imp_ P Q) := (! P.eval_atomic) || Q.eval_atomic
| (forall_ x P) := val (forall_ x P)

def formula.is_tauto_atomic (P : formula) : Prop :=
  ∀ (val : valuation), P.eval_atomic val = bool.tt

def eval_atomic_ff_to_not (val : valuation) (P : formula) : formula :=
if formula.eval_atomic val P = bool.tt then P else P.not_

lemma eval_atomic_atomic
  (P : formula)
  (val : valuation)
  (h1 : P.is_atomic) :
  P.eval_atomic val = val P :=
begin
  induction P,
  case [formula.true_, formula.not_, formula.imp_]
  {
    all_goals
    {
      unfold formula.is_atomic at h1,

      contradiction,
    }
  },
  case [formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      refl,
    }
  },
end

example
  (P : formula)
  (val val' : valuation)
  (h1 : ∀ (Q : formula), Q ∈ P.atomic_set → val Q = val' Q) :
  P.eval_atomic val = P.eval_atomic val' :=
begin
  induction P,
  case formula.true_
  {
    unfold formula.eval_atomic,
  },
  case [formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      unfold formula.atomic_set at h1,

      unfold formula.eval_atomic,
      apply h1,
      simp only [finset.mem_singleton, eq_self_iff_true, and_self],
    },
  },
  case formula.not_ : P P_ih
  {
    unfold formula.atomic_set at h1,

    unfold formula.eval_atomic,
    congr' 1,
    exact P_ih h1,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold formula.atomic_set at h1,
    simp only [finset.mem_union] at h1,

    unfold formula.eval_atomic,
    congr' 1,
    {
      congr' 1,
      apply P_ih,
      intros Q' a1,
      apply h1,
      left,
      exact a1,
    },
    {
      apply Q_ih,
      intros Q' a1,
      apply h1,
      right,
      exact a1,
    }
  },
end

lemma eval_atomic_subst_atomic_eq_eval_atomic_eval_atomic
  (P : formula)
  (σ : formula → formula)
  (val : valuation) :
  (P.subst_atomic σ).eval_atomic val =
    P.eval_atomic (fun (Q : formula), (σ Q).eval_atomic val) :=
begin
  induction P,
  case [formula.true_, formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      refl,
    }
  },
  case formula.not_ : P P_ih
  {
    unfold formula.subst_atomic,
    unfold formula.eval_atomic,
    congr,
    exact P_ih,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold formula.subst_atomic,
    unfold formula.eval_atomic,
    congr,
    {
      exact P_ih,
    },
    {
      exact Q_ih,
    }
  },
end

theorem is_tauto_atomic_imp_is_tauto_atomic_subst_atomic
  (P : formula)
  (h1 : P.is_tauto_atomic)
  (σ : formula → formula) :
  (formula.subst_atomic σ P).is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic at h1,

  unfold formula.is_tauto_atomic,
  intros val,
  simp only [eval_atomic_subst_atomic_eq_eval_atomic_eval_atomic P σ val],
  apply h1,
end

example
  (P Q R S : formula)
  (val : valuation)
  (σ : formula → formula)
  (h1 : P.eval_atomic val = Q.eval_atomic val) :
  (S.subst_atomic (function.update_ite σ R P)).eval_atomic val =
    (S.subst_atomic (function.update_ite σ R Q)).eval_atomic val :=
begin
  simp only [eval_atomic_subst_atomic_eq_eval_atomic_eval_atomic],
  congr' 1,
  funext Q',
  unfold function.update_ite,
  split_ifs,
  {
    exact h1,
  },
  {
    refl,
  }
end

theorem T_13_5
  (P : formula) :
  is_proof (P.imp_ P) :=
begin
  unfold is_proof,

  apply is_deduct.mp_,
  {
    apply is_deduct.mp_,
    {
      apply is_deduct.axiom_,
      exact is_axiom.prop_2_ P (P.imp_ P) P,
    },
    {
      apply is_deduct.axiom_,
      exact is_axiom.prop_1_ P (P.imp_ P),
    }
  },
  {
    apply is_deduct.axiom_,
    exact is_axiom.prop_1_ P P,
  },
end

alias T_13_5 <- prop_id

theorem T_13_6
  (P Q : formula) :
  is_proof (P.not_.imp_ (P.imp_ Q)) :=
begin
  unfold is_proof,

  apply is_deduct.mp_,
  {
    apply is_deduct.mp_,
    {
      apply is_deduct.axiom_,
      exact is_axiom.prop_2_ P.not_ (Q.not_.imp_ P.not_) (P.imp_ Q),
    },
    {
      apply is_deduct.mp_,
      {
        apply is_deduct.axiom_,
        exact is_axiom.prop_1_ ((Q.not_.imp_ P.not_).imp_ (P.imp_ Q)) P.not_,
      },
      {
        apply is_deduct.axiom_,
        exact is_axiom.prop_3_ Q P,
      }
    }
  },
  {
    apply is_deduct.axiom_,
    exact is_axiom.prop_1_ P.not_ Q.not_,
  },
end

-- Deduction Theorem

theorem T_14_3
  (P Q : formula)
  (Δ : set formula)
  (h1 : is_deduct (Δ ∪ {P}) Q) :
  is_deduct Δ (P.imp_ Q) :=
begin
  induction h1,
  case is_deduct.axiom_ : h1_P h1_1
  {
    apply is_deduct.mp_,
    {
      apply is_deduct.axiom_,
      exact is_axiom.prop_1_ h1_P P,
    },
    {
      apply is_deduct.axiom_,
      exact h1_1,
    },
  },
  case is_deduct.assume_ : h1_P h1_1
  {
    simp only [set.union_singleton, set.mem_insert_iff] at h1_1,
    cases h1_1,
    {
      subst h1_1,
      apply proof_imp_deduct,
      exact prop_id h1_P,
    },
    {
      apply is_deduct.mp_,
      {
        apply is_deduct.axiom_,
        exact is_axiom.prop_1_ h1_P P,
      },
      {
        apply is_deduct.assume_,
        exact h1_1,
      },
    }
  },
  case is_deduct.mp_ : h1_P h1_Q h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    apply is_deduct.mp_,
    {
      apply is_deduct.mp_,
      {
        apply is_deduct.axiom_,
        exact is_axiom.prop_2_ P h1_P h1_Q,
      },
      {
        exact h1_ih_1,
      }
    },
    {
      exact h1_ih_2,
    },
  },
end

alias T_14_3 <- deduction_theorem

example
  (P Q : formula) :
  is_proof (P.not_.imp_ (P.imp_ Q)) :=
begin
  unfold is_proof,

  apply deduction_theorem,
  apply is_deduct.mp_,
  {
    apply is_deduct.axiom_,
    exact is_axiom.prop_3_ Q P,
  },
  {
    apply is_deduct.mp_,
    {
      apply is_deduct.axiom_,
      exact is_axiom.prop_1_ P.not_ Q.not_,
    },
    {
      apply is_deduct.assume_,
      simp only [set.union_singleton, insert_emptyc_eq, set.mem_singleton],
    },
  },
end

theorem T_14_5
  (P : formula) :
  is_proof (P.not_.not_.imp_ P) :=
begin
  unfold is_proof,

  apply deduction_theorem,
  apply is_deduct.mp_ P.not_.not_,
  {
    apply is_deduct.mp_ (P.not_.imp_ P.not_.not_.not_),
    {
      apply is_deduct.axiom_,
      apply is_axiom.prop_3_,
    },
    {
      apply is_deduct.mp_ P.not_.not_,
      {
        apply proof_imp_deduct,
        apply T_13_6,
      },
      {
        apply is_deduct.assume_,
        simp only [set.union_singleton, insert_emptyc_eq, set.mem_singleton],
      }
    }
  },
  {
    apply is_deduct.assume_,
    simp only [set.union_singleton, insert_emptyc_eq, set.mem_singleton_iff],
  }
end

theorem T_14_6
  (P : formula) :
  is_proof (P.imp_ P.not_.not_) :=
begin
  unfold is_proof,

  apply is_deduct.mp_ (P.not_.not_.not_.imp_ P.not_),
  {
    apply is_deduct.axiom_,
    exact is_axiom.prop_3_ P.not_.not_ P,
  },
  {
    apply proof_imp_deduct,
    exact T_14_5 P.not_,
  }
end

theorem T_14_7
  (P Q : formula) :
  is_proof ((P.imp_ Q).imp_ (Q.not_.imp_ P.not_)) :=
begin
  unfold is_proof,

  apply deduction_theorem,
  apply is_deduct.mp_,
  {
    apply is_deduct.axiom_,
    apply is_axiom.prop_3_,
  },
  {
    apply deduction_theorem,
    apply is_deduct.mp_,
    {
      apply proof_imp_deduct,
      apply T_14_6,
    },
    {
      apply is_deduct.mp_,
      {
        apply is_deduct.assume_,
        simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton_iff, eq_self_iff_true, and_true,
  false_or],
      },
      {
        apply is_deduct.mp_,
        {
          apply proof_imp_deduct,
          apply T_14_5,
        },
        {
          apply is_deduct.assume_,
          simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton_iff, or_false],
        }
      }
    }
  }
end

theorem T_14_8
  (Q R : formula) :
  is_proof (Q.imp_ (R.not_.imp_ ((Q.imp_ R).not_))) :=
begin
  unfold is_proof,

  apply deduction_theorem,
  apply is_deduct.mp_,
  {
    apply proof_imp_deduct,
    apply T_14_7,
  },
  {
    apply deduction_theorem,
    apply is_deduct.mp_ Q R,
    {
      apply is_deduct.assume_,
      simp only [set.union_singleton, set.mem_insert_iff, eq_self_iff_true, and_self, true_or],
    },
    {
      apply is_deduct.assume_,
      simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton, or_true],
    }
  }
end

theorem T_14_9
  (P S : formula) :
  is_proof ((S.imp_ P).imp_ ((S.not_.imp_ P).imp_ P)) :=
begin
  unfold is_proof,

  apply deduction_theorem,
  apply is_deduct.mp_,
  {
    apply is_deduct.axiom_,
    apply is_axiom.prop_3_,
  },
  {
    apply deduction_theorem,
    apply is_deduct.mp_,
    {
      apply is_deduct.mp_,
      {
        apply proof_imp_deduct,
        apply T_14_8,
      },
      {
        apply is_deduct.mp_,
        {
          apply is_deduct.mp_ (S.imp_ P),
          {
            apply proof_imp_deduct,
            apply T_14_7,
          },
          {
            apply is_deduct.assume_,
            simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton, false_or],
          }
        },
        {
          apply is_deduct.assume_,
          simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton_iff, or_false],
        }
      }
    },
    {
      apply is_deduct.assume_,
      simp only [set.union_singleton, insert_emptyc_eq, set.mem_insert_iff, set.mem_singleton_iff, or_false],
    }
  }
end

theorem T_14_10
  (Q : formula)
  (Δ : set formula)
  (h1 : is_deduct Δ Q) :
  ∀ (Γ : set formula), is_deduct (Δ ∪ Γ) Q :=
begin
  intros Γ,
  induction h1,
  case is_deduct.axiom_ : h1_P h1_1
  {
    apply is_deduct.axiom_,
    exact h1_1,
  },
  case is_deduct.assume_ : h1_P h1_1
  {
    apply is_deduct.assume_,
    simp only [set.mem_union_eq],
    apply or.intro_left,
    exact h1_1,
  },
  case is_deduct.mp_ : h1_P h1_Q h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    apply is_deduct.mp_ h1_P h1_Q,
    {
      exact h1_ih_1,
    },
    {
      exact h1_ih_2,
    }
  },
end

theorem deduction_theorem_converse
  (P Q : formula)
  (Δ : set formula)
  (h1 : is_deduct Δ (P.imp_ Q)) :
  is_deduct (Δ ∪ {P}) Q :=
begin
  have s1 : is_deduct (Δ ∪ {P}) (P.imp_ Q),
  exact T_14_10 (P.imp_ Q) Δ h1 {P},

  have s2 : is_deduct (Δ ∪ {P}) P,
  apply is_deduct.assume_,
  simp only [set.union_singleton, set.mem_insert_iff, eq_self_iff_true, true_or],

  exact is_deduct.mp_ P Q s1 s2,
end

theorem C_14_11
  (Q : formula)
  (h1 : is_proof Q) :
  ∀ (Γ : set formula), is_deduct Γ Q :=
begin
  unfold is_proof at h1,

  intros Γ,
  rewrite <- set.union_empty Γ,
  rewrite set.union_comm,
  exact T_14_10 Q ∅ h1 Γ,
end

example :
  C_14_11 = proof_imp_deduct :=
begin
  refl,
end

theorem T_14_12
  (P Q : formula)
  (Δ Γ : set formula)
  (h1 : is_deduct Δ P)
  (h2 : is_deduct Γ (P.imp_ Q)) :
  is_deduct (Δ ∪ Γ) Q :=
begin
  have s1 : is_deduct (Δ ∪ Γ) P,
  apply T_14_10,
  exact h1,

  have s2 : is_deduct (Δ ∪ Γ) (P.imp_ Q),
  rewrite set.union_comm,
  apply T_14_10,
  exact h2,

  exact is_deduct.mp_ P Q s2 s1,
end

theorem C_14_13
  (P Q : formula)
  (Δ : set formula)
  (h1 : is_deduct Δ P)
  (h2 : is_deduct Δ (P.imp_ Q)) :
  is_deduct Δ Q :=
begin
  have s1 : is_deduct (Δ ∪ Δ) Q,
  exact T_14_12 P Q Δ Δ h1 h2,

  simp only [set.union_self] at s1,
  exact s1,
end

theorem C_14_13'
  (P Q : formula)
  (Δ : set formula)
  (h1 : is_deduct Δ P)
  (h2 : is_deduct Δ (P.imp_ Q)) :
  is_deduct Δ Q :=
begin
  exact is_deduct.mp_ P Q h2 h1,
end

theorem C_14_14
  (P Q : formula)
  (Γ : set formula)
  (h1 : is_proof P)
  (h2 : is_deduct Γ (P.imp_ Q)) :
  is_deduct Γ Q :=
begin
  have s1 : is_deduct Γ P,
  exact C_14_11 P h1 Γ,

  exact is_deduct.mp_ P Q h2 s1,
end

alias C_14_14 <- mp_proof_deduct

theorem C_14_15
  (P Q : formula)
  (Δ : set formula)
  (h1 : is_deduct Δ P)
  (h2 : is_proof (P.imp_ Q)) :
  is_deduct Δ Q :=
begin
  have s1 : is_deduct Δ (P.imp_ Q),
  exact C_14_11 (P.imp_ Q) h2 Δ,

  exact is_deduct.mp_ P Q s1 h1,
end

alias C_14_15 <- mp_deduct_proof

theorem T_14_16
  (Q : formula)
  (Δ Γ : set formula)
  (h1 : is_deduct Γ Q)
  (h2 : ∀ (P : formula), P ∈ Γ → is_deduct Δ P) :
  is_deduct Δ Q :=
begin
  induction h1,
  case is_deduct.axiom_ : h1_P h1_1
  {
    apply is_deduct.axiom_,
    exact h1_1,
  },
  case is_deduct.assume_ : h1_P h1_1
  {
    exact h2 h1_P h1_1,
  },
  case is_deduct.mp_ : h1_P h1_Q h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    exact is_deduct.mp_ h1_P h1_Q h1_ih_1 h1_ih_2,
  },
end

theorem C_14_17
  (Q : formula)
  (Γ : set formula)
  (h1 : is_deduct Γ Q)
  (h2 : ∀ (P : formula), P ∈ Γ → is_proof P) :
  is_proof Q :=
begin
  unfold is_proof at h2,

  unfold is_proof,
  exact T_14_16 Q ∅ Γ h1 h2,
end

theorem eval_not
  (P : formula)
  (val : valuation) :
  formula.eval_atomic val (not_ P) = bool.tt ↔
    ¬ (formula.eval_atomic val P = bool.tt) :=
begin
  unfold formula.eval_atomic,
  cases formula.eval_atomic val P;
  exact dec_trivial,
end

theorem eval_imp
  (P Q : formula)
  (val : valuation) :
  formula.eval_atomic val (imp_ P Q) = bool.tt ↔
    ((formula.eval_atomic val P = bool.tt) → (formula.eval_atomic val Q = bool.tt)) :=
begin
  unfold formula.eval_atomic,
  cases formula.eval_atomic val P;
  cases formula.eval_atomic val Q;
  exact dec_trivial,
end

theorem is_tauto_prop_true :
  true_.is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic,
  intro val,
  unfold formula.eval_atomic,
end

theorem is_tauto_prop_1
  (P Q : formula) :
  (P.imp_ (Q.imp_ P)).is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic,
  intro val,
  simp only [eval_imp],
  tauto,
end

theorem is_tauto_prop_2
  (P Q R : formula) :
  ((P.imp_ (Q.imp_ R)).imp_ ((P.imp_ Q).imp_ (P.imp_ R))).is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic,
  intro val,
  simp only [eval_imp],
  tauto,
end

theorem is_tauto_prop_3
  (P Q : formula) :
  (((not_ P).imp_ (not_ Q)).imp_ (Q.imp_ P)).is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic,
  intro val,
  simp only [eval_not, eval_imp],
  tauto,
end

theorem is_tauto_mp
  (P Q : formula)
  (h1 : (P.imp_ Q).is_tauto_atomic)
  (h2 : P.is_tauto_atomic) :
  Q.is_tauto_atomic :=
begin
  unfold formula.is_tauto_atomic at h1,
  unfold formula.is_tauto_atomic at h2,

  unfold formula.is_tauto_atomic,
  intro val,
  simp only [eval_imp] at h1,
  apply h1,
  exact h2 val,
end

example
  (P : formula)
  (h1 : is_prop_proof P) :
  P.is_tauto_atomic :=
begin
  induction h1,
  case is_prop_deduct.axiom_ : h1_P h1_1
  {
    induction h1_1,
    case is_prop_axiom.prop_true_ :
    {
      exact is_tauto_prop_true,
    },
    case is_prop_axiom.prop_1_ : h1_1_P h1_1_Q
    {
      exact is_tauto_prop_1 h1_1_P h1_1_Q,
    },
    case is_prop_axiom.prop_2_ : h1_1_P h1_1_Q h1_1_R
    {
      exact is_tauto_prop_2 h1_1_P h1_1_Q h1_1_R,
    },
    case is_prop_axiom.prop_3_ : h1_1_P h1_1_Q
    {
      exact is_tauto_prop_3 h1_1_P h1_1_Q,
    },
  },
  case is_prop_deduct.assume_ : h1_P h1_1
  {
    simp only [set.mem_empty_eq] at h1_1,
    contradiction,
  },
  case is_prop_deduct.mp_ : h1_P h1_Q h1_1 h1_2 h1_ih_1 h1_ih_2
  {
    exact is_tauto_mp h1_P h1_Q h1_ih_1 h1_ih_2,
  },
end

lemma mem_atomic_set_is_atomic
  (P P' : formula)
  (h1 : P' ∈ P.atomic_set) :
  P'.is_atomic :=
begin
  induction P,
  case formula.true_
  {
    unfold formula.atomic_set at h1,
    simp only [finset.not_mem_empty] at h1,

    contradiction,
  },
  case [formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      unfold formula.atomic_set at h1,
      simp only [finset.mem_singleton] at h1,

      subst h1,
      unfold formula.is_atomic,
    }
  },
  case formula.not_ : P P_ih
  {
    unfold formula.atomic_set at h1,

    exact P_ih h1,
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold formula.atomic_set at h1,
    simp only [finset.mem_union] at h1,

    tauto,
  },
end

lemma bnot_eq_tt_iff_not_eq_tt
  (b : bool) :
  !b = bool.tt ↔ ¬ b = bool.tt :=
begin
  simp only [bnot_eq_true_eq_eq_ff, eq_ff_eq_not_eq_tt],
end

lemma L_15_7
  (P P' : formula)
  (Δ_U : set formula)
  (val : valuation)
  (Δ_U' : set formula)
  (h1 : coe P.atomic_set ⊆ Δ_U)
  (h2 : Δ_U' = Δ_U.image (eval_atomic_ff_to_not val))
  (h3 : P' = eval_atomic_ff_to_not val P) :
  is_deduct Δ_U' P' :=
begin
  subst h2,
  subst h3,
  induction P,
  case formula.true_
  {
    apply is_deduct.axiom_,
    apply is_axiom.prop_true_,
  },
  case formula.pred_ : name args
  {
    let P := pred_ name args,

    unfold formula.atomic_set at h1,
    simp only [finset.coe_singleton, set.singleton_subset_iff] at h1,

    unfold eval_atomic_ff_to_not,
    unfold formula.eval_atomic,
    apply is_deduct.assume_,
    simp only [finset.coe_image, set.mem_image, finset.mem_coe],
    apply exists.intro P,
    tauto,
  },
  case formula.eq_ : x y
  {
    let P := eq_ x y,

    unfold formula.atomic_set at h1,
    simp only [finset.coe_singleton, set.singleton_subset_iff] at h1,

    unfold eval_atomic_ff_to_not,
    unfold formula.eval_atomic,
    apply is_deduct.assume_,
    simp only [finset.coe_image, set.mem_image, finset.mem_coe],
    apply exists.intro P,
    tauto,
  },
  case formula.not_ : P P_ih
  {
    unfold formula.atomic_set at h1,

    unfold eval_atomic_ff_to_not at P_ih,

    unfold eval_atomic_ff_to_not,
    unfold formula.eval_atomic,

    simp only [bnot_eq_tt_iff_not_eq_tt],
    split_ifs,
    {
      simp only [if_pos h] at P_ih,
      apply is_deduct.mp_ P,
      {
        apply proof_imp_deduct,
        apply T_14_6,
      },
      {
        exact P_ih h1,
      },
    },
    {
      simp only [if_neg h] at P_ih,
      exact P_ih h1,
    },
  },
  case formula.imp_ : P Q P_ih Q_ih
  {
    unfold formula.atomic_set at h1,
    simp only [finset.coe_union, set.union_subset_iff] at h1,
    cases h1,

    unfold eval_atomic_ff_to_not at P_ih,
    unfold eval_atomic_ff_to_not at Q_ih,

    unfold eval_atomic_ff_to_not,
    unfold formula.eval_atomic,
    simp only [bor_eq_true_eq_eq_tt_or_eq_tt],
    simp only [bnot_eq_tt_iff_not_eq_tt],
    split_ifs,
    {
      cases h,
      {
        simp only [if_neg h] at P_ih,
        apply is_deduct.mp_ P.not_,
        {
          apply proof_imp_deduct,
          apply T_13_6,
        },
        {
          exact P_ih h1_left,
        },
      },
      {
        simp only [if_pos h] at Q_ih,

        apply is_deduct.mp_ Q,
        {
          apply is_deduct.axiom_,
          apply is_axiom.prop_1_,
        },
        {
          exact Q_ih h1_right,
        },
      }
    },
    {
      push_neg at h,
      dsimp at h,
      cases h,
      simp only [if_pos h_left] at P_ih,
      simp only [if_neg h_right] at Q_ih,
      apply is_deduct.mp_ Q.not_,
      {
        apply is_deduct.mp_ P,
        {
          apply proof_imp_deduct,
          apply T_14_8,
        },
        {
          exact P_ih h1_left,
        }
      },
      {
        exact Q_ih h1_right,
      },
    }
  },
  case formula.forall_ : x P P_ih
  {
    let P := forall_ x P,

    unfold formula.atomic_set at h1,
    simp only [finset.coe_singleton, set.singleton_subset_iff] at h1,

    unfold eval_atomic_ff_to_not,
    unfold formula.eval_atomic,
    apply is_deduct.assume_,
    simp only [finset.coe_image, set.mem_image, finset.mem_coe],
    apply exists.intro P,
    tauto,
  },
end

lemma T_14_9_deduct
  (P U : formula)
  (Δ : set formula)
  (h1 : is_deduct (Δ ∪ {U}) P)
  (h2 : is_deduct (Δ ∪ {U.not_}) P) :
  is_deduct Δ P :=
begin
  apply is_deduct.mp_ (U.not_.imp_ P),
  {
    apply is_deduct.mp_ (U.imp_ P),
    {
      apply proof_imp_deduct,
      apply T_14_9,
    },
    {
      apply deduction_theorem,
      exact h1,
    },
  },
  {
    apply deduction_theorem,
    exact h2,
  }
end

lemma eval_atomic_ff_to_not_of_function_update_ite_tt
  (P P' : formula)
  (val : valuation)
  (h1 : P.is_atomic) :
  eval_atomic_ff_to_not (function.update_ite val P' bool.tt) P =
    function.update_ite (eval_atomic_ff_to_not val) P' P P :=
begin
  induction P,
  case formula.true_
  {
    unfold function.update_ite,
    unfold eval_atomic_ff_to_not,
    tauto,
  },
  case [formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      unfold function.update_ite,
      unfold eval_atomic_ff_to_not,
      unfold formula.eval_atomic,
      unfold function.update_ite,
      split_ifs; tauto,
    }
  },
  case [formula.not_, formula.imp_]
  {
    all_goals
    {
      unfold formula.is_atomic at h1,

      contradiction,
    }
  },
end

lemma eval_atomic_ff_to_not_of_function_update_ite_ff
  (P P' : formula)
  (val : valuation)
  (h1 : P.is_atomic) :
  eval_atomic_ff_to_not (function.update_ite val P' bool.ff) P =
    function.update_ite (eval_atomic_ff_to_not val) P' P.not_ P :=
begin
  induction P,
  case formula.true_
  {
    unfold function.update_ite,
    unfold eval_atomic_ff_to_not,
    tauto,
  },
  case [formula.pred_, formula.eq_, formula.forall_]
  {
    all_goals
    {
      unfold function.update_ite,
      unfold eval_atomic_ff_to_not,
      unfold formula.eval_atomic,
      unfold function.update_ite,
      split_ifs; tauto,
    }
  },
  case [formula.not_, formula.imp_]
  {
    all_goals
    {
      unfold formula.is_atomic at h1,

      contradiction,
    }
  },
end

lemma image_of_eval_atomic_ff_to_not_of_function_update_ite
  (U : formula)
  (Δ : set formula)
  (val : valuation)
  (b : bool)
  (h1_Δ: ∀ (U' : formula), (U' ∈ Δ) → U'.is_atomic)
  (h1_U: U.is_atomic)
  (h2: U ∉ Δ) :
  Δ.image (eval_atomic_ff_to_not (function.update_ite val U b)) =
    Δ.image (eval_atomic_ff_to_not val) :=
begin
  apply set.image_congr,
  intros U' a1,
  specialize h1_Δ U' a1,
  cases b,
  {
    simp only [eval_atomic_ff_to_not_of_function_update_ite_ff U' U val h1_Δ],
    unfold function.update_ite,
    simp only [ite_eq_right_iff],
    intros a2,
    subst a2,
    contradiction,
  },
  {
    simp only [eval_atomic_ff_to_not_of_function_update_ite_tt U' U val h1_Δ],
    unfold function.update_ite,
    simp only [ite_eq_right_iff],
    intros a2,
    subst a2,
    contradiction,
  }
end

lemma prop_complete_aux_aux
  (P U : formula)
  (Δ : set formula)
  (h1_Δ : ∀ (U' : formula), U' ∈ Δ → U'.is_atomic)
  (h1_U : U.is_atomic)
  (h2 : U ∉ Δ)
  (h3 : ∀ (val : valuation), is_deduct ((Δ.image (eval_atomic_ff_to_not val)) ∪ {eval_atomic_ff_to_not val U}) P) :
  ∀ (val : valuation), is_deduct (Δ.image (eval_atomic_ff_to_not val)) P :=
begin
  intros val,
  apply T_14_9_deduct P U (Δ.image (eval_atomic_ff_to_not val)),
  {
    specialize h3 (function.update_ite val U bool.tt),
    simp only [image_of_eval_atomic_ff_to_not_of_function_update_ite U Δ val bool.tt h1_Δ h1_U h2] at h3,
    simp only [eval_atomic_ff_to_not_of_function_update_ite_tt U U val h1_U] at h3,
    unfold function.update_ite at h3,
    simp only [eq_self_iff_true, if_true] at h3,
    exact h3,
  },
  {
    specialize h3 (function.update_ite val U bool.ff),
    simp only [image_of_eval_atomic_ff_to_not_of_function_update_ite U Δ val bool.ff h1_Δ h1_U h2] at h3,
    simp only [eval_atomic_ff_to_not_of_function_update_ite_ff U U val h1_U] at h3,
    unfold function.update_ite at h3,
    simp only [eq_self_iff_true, if_true] at h3,
    exact h3,
  }
end

theorem prop_complete_aux
  (P : formula)
  (Δ_U : finset formula)
  (h1 : P.is_tauto_atomic)
  (h2 : Δ_U ⊆ P.atomic_set)
  (h3 : ∀ (val : valuation), is_deduct (Δ_U.image (eval_atomic_ff_to_not val)) P) :
  is_deduct ∅ P :=
begin
  induction Δ_U using finset.induction_on,
  case h₁
  {
    simp only [finset.image_empty, finset.coe_empty, forall_const] at h3,

    exact h3,
  },
  case h₂ : U Δ_U Δ_U_1 Δ_U_2
  {
    apply Δ_U_2,
    {
      simp only [finset.insert_subset] at h2,
      cases h2,

      exact h2_right,
    },
    {
      simp only [finset.insert_subset] at h2,
      cases h2,

      simp only [finset.image_insert, finset.coe_insert, finset.coe_image] at h3,

      simp only [finset.coe_image],
      apply prop_complete_aux_aux P U Δ_U,
      {
        intros U' a1,
        apply mem_atomic_set_is_atomic P U',
        apply h2_right,
        exact a1,
      },
      {
        apply mem_atomic_set_is_atomic P U,
        exact h2_left,
      },
      {
        exact Δ_U_1,
      },
      {
        simp only [set.union_singleton],
        exact h3,
      }
    }
  },
end

theorem prop_complete
  (P : formula)
  (h1 : P.is_tauto_atomic) :
  is_proof P :=
begin
  unfold is_proof,

  apply prop_complete_aux P P.atomic_set h1,
  {
    refl,
  },
  {
    intros val,
    apply L_15_7 P P P.atomic_set val (P.atomic_set.image (eval_atomic_ff_to_not val)),
    {
      refl,
    },
    {
      simp only [finset.coe_image],
    },
    {
      unfold formula.is_tauto_atomic at h1,

      unfold eval_atomic_ff_to_not,
      specialize h1 val,
      simp only [if_pos h1],
    }
  }
end


import data.complex.is_R_or_C
import analysis.inner_product_space.pi_L2

variables {m n : ℕ}

variables (𝕜 : Type*)
[is_R_or_C 𝕜]

open_locale big_operators complex_conjugate matrix topological_space

local notation `𝕜^n` := (euclidean_space 𝕜 (fin n))

local notation `M_n` := (matrix (fin n) (fin n) 𝕜)

local notation `U_n` := matrix.unitary_group (fin n) 𝕜

variables (A B : ℕ → M_n) (L : M_n)

/-
matrix_SVD should look like this:
-/
noncomputable def matrix_SVD (M : M_n) : (fin 3) → M_n := sorry

theorem limit_svd_is_svd (h_lim : filter.tendsto A filter.at_top (𝓝 L))


import order

import lib.list

import etv.defs
import etv.label

open order_dual

variables {α : Type*} [linear_order α] (C : config α)

lemma config.join_n2_n2_case_ff
  (S : finset α) (n : ℕ) (a x b : α) (c1 c2 : list α) (lab : C.label S)
  (a_in_S : a ∈ S) (x_in_S : x ∈ S) (b_in_S : b ∈ S)
  (hc1 : C.ncup (n+2) (c1 ++ [a, x])) (c1_in_S : c1.in S)
  (hc2 : C.ncup (n+2) (x :: b :: c2)) (c2_in_S : c2.in S)
  (sab : ¬lab.slope a b) :
  C.has_ngon (n+3) S :=
begin
  have hax : a < x := by simp [config.cup, config.ncup] at hc1; tauto,
  have hxb : x < b := by simp [config.cup, config.ncup] at hc2; tauto,
  have hab : a < b := has_lt.lt.trans hax hxb,
  have h_b_c2 : b :: c2 ≠ [] := by simp,
  rcases list.take_last h_b_c2 with ⟨c, c3, eq_c2⟩,
  rw eq_c2 at hc2,
  have hxc : x < c := by
    apply hc2.head'_lt_last' x c; simp; dec_trivial,
  have c_in_S : c ∈ S := begin
    have h_in : (b :: c2).in S := by simp; tauto,
    rw eq_c2 at h_in, simp at h_in, tauto,
  end,
  by_cases haxc : C.cup3 a x c,
  { apply ncup_is_ngon, dec_trivial,
    use c1 ++ [a, x, c], split, split,
    simp, rw config.ncup at hc1, tauto,
    simp, simp [config.ncup] at hc1, tauto,
    simp, tauto },
  { use [[a, x, c], a :: (c3 ++ [c])],
    refine ⟨⟨_, _⟩, _, _⟩; try {simp}; try {tauto},
    split, tauto, split, dec_trivial,
    rw ←eq_c2, rw ←eq_c2 at hc2,
    have hbc2 := hc2.tail.left, simp at hbc2,
    apply hbc2.extend_left sab; try {tauto},
    simp, tauto, simp [config.ncup] at hc2,
    ring_nf, ring_nf at hc2, simp, simp at hc2,
    exact hc2.right, split, assumption,
    have hh : (b :: c2).in S := by simp; tauto,
    rw eq_c2 at hh, simp at hh, exact hh },
end

lemma config.join_n2_n2_case_tt
  (S : finset α) (n : ℕ) (a x b : α) (c1 c2 : list α) (lab : C.label S)
  (a_in_S : a ∈ S) (x_in_S : x ∈ S) (b_in_S : b ∈ S)
  (hc1 : C.ncup (n+2) (c1 ++ [a, x])) (c1_in_S : c1.in S)
  (hc2 : C.ncup (n+2) (x :: b :: c2)) (c2_in_S : c2.in S)
  (hab : lab.slope a b) :
  C.has_ngon (n+3) S :=
begin
  rw ←finset.mem_mirror at a_in_S x_in_S b_in_S,
  rw ←mirror.ncup at hc1 hc2,
  rw ←list.mirror_in at c1_in_S c2_in_S,
  simp at hc1 hc2,
  have hba := hab, rw ←mirror_slope at hba,

  have mirrored_goal :=
    (C.mirror).join_n2_n2_case_ff
      S.mirror n
      (to_dual b) (to_dual x) (to_dual a)
      c2.mirror c1.mirror lab.mirror
      b_in_S x_in_S a_in_S hc2 c2_in_S hc1 c1_in_S hba,
  rw mirror.has_ngon at mirrored_goal,
  tauto
end

lemma config.join_n2_n2 (S : finset α)
  {n : ℕ}
  (cap4_free : ¬C.has_ncap 4 S)
  {c1 : list α} (hc1 : C.ncup (n+2) c1) (c1_in_S : c1.in S)
  {c2 : list α} (hc2 : C.ncup (n+2) c2) (c2_in_S : c2.in S)
  (x : α) (hx1 : x ∈ c1.last') (hx2 : x ∈ c2.head') : C.has_ngon (n+3) S :=
begin
  -- Introduce variables
  have c1_size2 : 2 ≤ c1.length := by cases hc1; linarith,
  rcases list.take_last2 c1_size2 with ⟨a, x, c1', eq_c1⟩,
  subst eq_c1, simp at hx1, subst hx1,
  have c2_size2 : 2 ≤ c2.length := by cases hc2; linarith,
  rcases list.take_head2 c2_size2 with ⟨x, b, c2', eq_c2⟩,
  subst eq_c2, simp at hx2, subst hx2,

  have lab := cap4_free_label cap4_free,
  by_cases hl : lab.slope a b,
  { apply C.join_n2_n2_case_tt S n a x b c1' c2' lab;
    simp at c1_in_S c2_in_S; tauto },
  { apply C.join_n2_n2_case_ff S n a x b c1' c2' lab;
    simp at c1_in_S c2_in_S; tauto },
end


import .interp
import .expr

open arith
open arith.var

-- variables

def X := Δ 0
def Y := Δ 1
def Z := Δ 2
def W := Δ 0  -- W and X are the same variable

-- an interpretation

def init : var → nat
| v := nat.zero

-- test interpretation override

example : init X = 0 := rfl
example : init Y = 0 := rfl
example : init Z = 0 := rfl

-- "assignment operation"
-- {X = 0, Y = 0, Z = 0}
def st_1 := override init X 2
-- {X = 2, Y = 0, Z = 0}

example : st_1 X = 2 := rfl
example : st_1 Y = 0 := rfl
example : st_1 Z = 0 := rfl

-- "assignment operation"
-- {X = 2, Y = 0, Z = 0}
def st_2 := override (st_1) Z 5
-- {X = 2, Y = 0, Z = 5}

example : st_2 X = 2 := rfl
example : st_2 Y = 0 := rfl
example : st_2 Z = 5 := rfl

-- example expressions

def e1 := [0] -- overloaded []: literal expresion
def e2 := e1 + e1
def e3 := e2++
def e4 := ⟨ X ⟩   -- []: "var" expression

-- test evaluation

example : eval e3 init = 1 := rfl
example : eval e4 st_2 = 7 := rfl


/-
Copyright (c) 2022 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam
-/
import logic.function.basic
import data.finset.card
import data.fintype.basic

/--
Five different awards are to be given to three students.
Each student will receive at least one award.
In how many different ways can the awards be distributed?
-/
theorem amc8_2020_p23 :
  (finset.filter function.surjective finset.univ : finset (fin 5 → fin 3)).card = 150 :=
begin
  dec_trivial
end


example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) :=
begin
    intro pq,
    intro qf,
    intro p,
    apply qf,
    apply pq,
    exact p,
end