/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Leonardo de Moura
-/
import logic.connectives logic.identities algebra.binary
open eq.ops binary function

definition set (X : Type) := X → Prop

namespace set

variable {X : Type}

/- membership and subset -/

definition mem (x : X) (a : set X) := a x
infix ∈ := mem
notation a ∉ b := ¬ mem a b

theorem ext {a b : set X} (H : ∀x, x ∈ a ↔ x ∈ b) : a = b :=
funext (take x, propext (H x))

definition subset (a b : set X) := ∀⦃x⦄, x ∈ a → x ∈ b
infix ⊆ := subset

definition superset (s t : set X) : Prop := t ⊆ s
infix ⊇ := superset

theorem subset.refl (a : set X) : a ⊆ a := take x, assume H, H

theorem subset.trans {a b c : set X} (subab : a ⊆ b) (subbc : b ⊆ c) : a ⊆ c :=
take x, assume ax, subbc (subab ax)

theorem subset.antisymm {a b : set X} (h₁ : a ⊆ b) (h₂ : b ⊆ a) : a = b :=
ext (λ x, iff.intro (λ ina, h₁ ina) (λ inb, h₂ inb))

-- an alterantive name
theorem eq_of_subset_of_subset {a b : set X} (h₁ : a ⊆ b) (h₂ : b ⊆ a) : a = b :=
subset.antisymm h₁ h₂

theorem mem_of_subset_of_mem {s₁ s₂ : set X} {a : X} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ :=
assume h₁ h₂, h₁ _ h₂

/- strict subset -/

definition strict_subset (a b : set X) := a ⊆ b ∧ a ≠ b
infix ` ⊂ `:50 := strict_subset

theorem strict_subset.irrefl (a : set X) : ¬ a ⊂ a :=
assume h, absurd rfl (and.elim_right h)

/- bounded quantification -/

abbreviation bounded_forall (a : set X) (P : X → Prop) := ∀⦃x⦄, x ∈ a → P x
notation `forallb` binders ` ∈ ` a `, ` r:(scoped:1 P, P) := bounded_forall a r
notation `∀₀` binders ` ∈ ` a `, ` r:(scoped:1 P, P) := bounded_forall a r

abbreviation bounded_exists (a : set X) (P : X → Prop) := ∃⦃x⦄, x ∈ a ∧ P x
notation `existsb` binders ` ∈ ` a `, ` r:(scoped:1 P, P) := bounded_exists a r
notation `∃₀` binders ` ∈ ` a `, ` r:(scoped:1 P, P) := bounded_exists a r

theorem bounded_exists.intro {P : X → Prop} {s : set X} {x : X} (xs : x ∈ s) (Px : P x) :
  ∃₀ x ∈ s, P x :=
exists.intro x (and.intro xs Px)

lemma bounded_forall_congr {A : Type} {S : set A} {P Q : A → Prop} (H : ∀₀ x ∈ S, P x ↔ Q x) :
  (∀₀ x ∈ S, P x) = (∀₀ x ∈ S, Q x) :=
begin
  apply propext,
  apply forall_congr,
  intros x,
  apply imp_congr_right,
  apply H
end

lemma bounded_exists_congr {A : Type} {S : set A} {P Q : A → Prop} (H : ∀₀ x ∈ S, P x ↔ Q x) :
  (∃₀ x ∈ S, P x) = (∃₀ x ∈ S, Q x) :=
begin
  apply propext,
  apply exists_congr,
  intros x,
  apply and_congr_right,
  apply H
end

section
  open classical

  lemma not_bounded_exists {A : Type} {S : set A} {P : A → Prop} :
    (¬ (∃₀ x ∈ S, P x)) = (∀₀ x ∈ S, ¬ P x) :=
  begin
    rewrite forall_iff_not_exists,
    apply propext,
    apply forall_congr,
    intro x,
    rewrite not_and_iff_not_or_not,
    symmetry,
    apply imp_iff_not_or
  end

  lemma not_bounded_forall {A : Type} {S : set A} {P : A → Prop} :
    (¬ (∀₀ x ∈ S, P x)) = (∃₀ x ∈ S, ¬ P x) :=
  calc (¬ (∀₀ x ∈ S, P x)) = ¬ ¬ (∃₀ x ∈ S, ¬ P x) :
    begin
      rewrite not_bounded_exists,
      apply (congr_arg not),
      apply bounded_forall_congr,
      intros x H,
      rewrite not_not_iff
    end
    ... = (∃₀ x ∈ S, ¬ P x) : by (rewrite not_not_iff)

end

/- empty set -/

definition empty : set X := λx, false
notation `∅` := empty

theorem not_mem_empty (x : X) : ¬ (x ∈ ∅) :=
assume H : x ∈ ∅, H

theorem mem_empty_eq (x : X) : x ∈ ∅ = false := rfl

theorem eq_empty_of_forall_not_mem {s : set X} (H : ∀ x, x ∉ s) : s = ∅ :=
ext (take x, iff.intro
  (assume xs, absurd xs (H x))
  (assume xe, absurd xe !not_mem_empty))

theorem ne_empty_of_mem {s : set X} {x : X} (H : x ∈ s) : s ≠ ∅ :=
  begin intro Hs, rewrite Hs at H, apply not_mem_empty _ H end

section
  open classical

  theorem exists_mem_of_ne_empty {s : set X} (H : s ≠ ∅) : ∃ x, x ∈ s :=
  by_contradiction (assume H', H (eq_empty_of_forall_not_mem (forall_not_of_not_exists H')))
end

theorem empty_subset (s : set X) : ∅ ⊆ s :=
take x, assume H, false.elim H

theorem eq_empty_of_subset_empty {s : set X} (H : s ⊆ ∅) : s = ∅ :=
subset.antisymm H (empty_subset s)

theorem subset_empty_iff (s : set X) : s ⊆ ∅ ↔ s = ∅ :=
iff.intro eq_empty_of_subset_empty (take xeq, by rewrite xeq; apply subset.refl ∅)

lemma bounded_forall_empty_iff {P : X → Prop} :
  (∀₀x∈∅, P x) ↔ true :=
iff.intro (take H, true.intro) (take H, by contradiction)

/- universal set -/

definition univ : set X := λx, true

theorem mem_univ (x : X) : x ∈ univ := trivial

theorem mem_univ_iff (x : X) : x ∈ univ ↔ true := !iff.refl

theorem mem_univ_eq (x : X) : x ∈ univ = true := rfl

theorem empty_ne_univ [h : inhabited X] : (empty : set X) ≠ univ :=
assume H : empty = univ,
absurd (mem_univ (inhabited.value h)) (eq.rec_on H (not_mem_empty _))

theorem subset_univ (s : set X) : s ⊆ univ := λ x H, trivial

theorem eq_univ_of_univ_subset {s : set X} (H : univ ⊆ s) : s = univ :=
eq_of_subset_of_subset (subset_univ s) H

theorem eq_univ_of_forall {s : set X} (H : ∀ x, x ∈ s) : s = univ :=
ext (take x, iff.intro (assume H', trivial) (assume H', H x))

/- union -/

definition union (a b : set X) : set X := λx, x ∈ a ∨ x ∈ b
notation a ∪ b := union a b

theorem mem_union_left {x : X} {a : set X} (b : set X) : x ∈ a → x ∈ a ∪ b :=
assume h, or.inl h

theorem mem_union_right {x : X} {b : set X} (a : set X) : x ∈ b → x ∈ a ∪ b :=
assume h, or.inr h

theorem mem_unionl {x : X} {a b : set X} : x ∈ a → x ∈ a ∪ b :=
assume h, or.inl h

theorem mem_unionr {x : X} {a b : set X} : x ∈ b → x ∈ a ∪ b :=
assume h, or.inr h

theorem mem_or_mem_of_mem_union {x : X} {a b : set X} (H : x ∈ a ∪ b) : x ∈ a ∨ x ∈ b := H

theorem mem_union.elim {x : X} {a b : set X} {P : Prop}
    (H₁ : x ∈ a ∪ b) (H₂ : x ∈ a → P) (H₃ : x ∈ b → P) : P :=
or.elim H₁ H₂ H₃

theorem mem_union_iff (x : X) (a b : set X) : x ∈ a ∪ b ↔ x ∈ a ∨ x ∈ b := !iff.refl

theorem mem_union_eq (x : X) (a b : set X) : x ∈ a ∪ b = (x ∈ a ∨ x ∈ b) := rfl

theorem union_self (a : set X) : a ∪ a = a :=
ext (take x, !or_self)

theorem union_empty (a : set X) : a ∪ ∅ = a :=
ext (take x, !or_false)

theorem empty_union (a : set X) : ∅ ∪ a = a :=
ext (take x, !false_or)

theorem union_comm (a b : set X) : a ∪ b = b ∪ a :=
ext (take x, or.comm)

theorem union_assoc (a b c : set X) : (a ∪ b) ∪ c = a ∪ (b ∪ c) :=
ext (take x, or.assoc)

theorem union_left_comm (s₁ s₂ s₃ : set X) : s₁ ∪ (s₂ ∪ s₃) = s₂ ∪ (s₁ ∪ s₃) :=
!left_comm union_comm union_assoc s₁ s₂ s₃

theorem union_right_comm (s₁ s₂ s₃ : set X) : (s₁ ∪ s₂) ∪ s₃ = (s₁ ∪ s₃) ∪ s₂ :=
!right_comm union_comm union_assoc s₁ s₂ s₃

theorem subset_union_left (s t : set X) : s ⊆ s ∪ t := λ x H, or.inl H

theorem subset_union_right (s t : set X) : t ⊆ s ∪ t := λ x H, or.inr H

theorem union_subset {s t r : set X} (sr : s ⊆ r) (tr : t ⊆ r) : s ∪ t ⊆ r :=
λ x xst, or.elim xst (λ xs, sr xs) (λ xt, tr xt)

/- intersection -/

definition inter (a b : set X) : set X := λx, x ∈ a ∧ x ∈ b
notation a ∩ b := inter a b

theorem mem_inter_iff (x : X) (a b : set X) : x ∈ a ∩ b ↔ x ∈ a ∧ x ∈ b := !iff.refl

theorem mem_inter_eq (x : X) (a b : set X) : x ∈ a ∩ b = (x ∈ a ∧ x ∈ b) := rfl

theorem mem_inter {x : X} {a b : set X} (Ha : x ∈ a) (Hb : x ∈ b) : x ∈ a ∩ b :=
and.intro Ha Hb

theorem mem_of_mem_inter_left {x : X} {a b : set X} (H : x ∈ a ∩ b) : x ∈ a :=
and.left H

theorem mem_of_mem_inter_right {x : X} {a b : set X} (H : x ∈ a ∩ b) : x ∈ b :=
and.right H

theorem inter_self (a : set X) : a ∩ a = a :=
ext (take x, !and_self)

theorem inter_empty (a : set X) : a ∩ ∅ = ∅ :=
ext (take x, !and_false)

theorem empty_inter (a : set X) : ∅ ∩ a = ∅ :=
ext (take x, !false_and)

theorem nonempty_of_inter_nonempty_right {T : Type} {s t : set T} (H : s ∩ t ≠ ∅) : t ≠ ∅ :=
suppose t = ∅,
have s ∩ t = ∅, by rewrite this; apply inter_empty,
H this

theorem nonempty_of_inter_nonempty_left {T : Type} {s t : set T} (H : s ∩ t ≠ ∅) : s ≠ ∅ :=
suppose s = ∅,
have s ∩ t = ∅, by rewrite this; apply empty_inter,
H this

theorem inter_comm (a b : set X) : a ∩ b = b ∩ a :=
ext (take x, !and.comm)

theorem inter_assoc (a b c : set X) : (a ∩ b) ∩ c = a ∩ (b ∩ c) :=
ext (take x, !and.assoc)

theorem inter_left_comm (s₁ s₂ s₃ : set X) : s₁ ∩ (s₂ ∩ s₃) = s₂ ∩ (s₁ ∩ s₃) :=
!left_comm inter_comm inter_assoc s₁ s₂ s₃

theorem inter_right_comm (s₁ s₂ s₃ : set X) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
!right_comm inter_comm inter_assoc s₁ s₂ s₃

theorem inter_univ (a : set X) : a ∩ univ = a :=
ext (take x, !and_true)

theorem univ_inter (a : set X) : univ ∩ a = a :=
ext (take x, !true_and)

theorem inter_subset_left (s t : set X) : s ∩ t ⊆ s := λ x H, and.left H

theorem inter_subset_right (s t : set X) : s ∩ t ⊆ t := λ x H, and.right H

theorem inter_subset_inter_right {s t : set X} (u : set X) (H : s ⊆ t) : s ∩ u ⊆ t ∩ u :=
take x, assume xsu, and.intro (H (and.left xsu)) (and.right xsu)

theorem inter_subset_inter_left {s t : set X} (u : set X) (H : s ⊆ t) : u ∩ s ⊆ u ∩ t :=
take x, assume xus, and.intro (and.left xus) (H (and.right xus))

theorem subset_inter {s t r : set X} (rs : r ⊆ s) (rt : r ⊆ t) : r ⊆ s ∩ t :=
λ x xr, and.intro (rs xr) (rt xr)

theorem not_mem_of_mem_of_not_mem_inter_left {s t : set X} {x : X} (Hxs : x ∈ s) (Hnm : x ∉ s ∩ t) : x ∉ t :=
  suppose x ∈ t,
  have x ∈ s ∩ t, from and.intro Hxs this,
  show false, from Hnm this

theorem not_mem_of_mem_of_not_mem_inter_right {s t : set X} {x : X} (Hxs : x ∈ t) (Hnm : x ∉ s ∩ t) : x ∉ s :=
  suppose x ∈ s,
  have x ∈ s ∩ t, from and.intro this Hxs,
  show false, from Hnm this

/- distributivity laws -/

theorem inter_distrib_left (s t u : set X) : s ∩ (t ∪ u) = (s ∩ t) ∪ (s ∩ u) :=
ext (take x, !and.left_distrib)

theorem inter_distrib_right (s t u : set X) : (s ∪ t) ∩ u = (s ∩ u) ∪ (t ∩ u) :=
ext (take x, !and.right_distrib)

theorem union_distrib_left (s t u : set X) : s ∪ (t ∩ u) = (s ∪ t) ∩ (s ∪ u) :=
ext (take x, !or.left_distrib)

theorem union_distrib_right (s t u : set X) : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) :=
ext (take x, !or.right_distrib)

/- set-builder notation -/

-- {x : X | P}
definition set_of (P : X → Prop) : set X := P
notation `{` binder ` | ` r:(scoped:1 P, set_of P) `}` := r

-- {x ∈ s | P}
definition sep (P : X → Prop) (s : set X) : set X := λx, x ∈ s ∧ P x
notation `{` binder ` ∈ ` s ` | ` r:(scoped:1 p, sep p s) `}` := r

/- insert -/

definition insert (x : X) (a : set X) : set X := {y : X | y = x ∨ y ∈ a}

-- '{x, y, z}
notation `'{`:max a:(foldr `, ` (x b, insert x b) ∅) `}`:0 := a

theorem subset_insert (x : X) (a : set X) : a ⊆ insert x a :=
take y, assume ys, or.inr ys

theorem mem_insert (x : X) (s : set X) : x ∈ insert x s :=
or.inl rfl

theorem mem_insert_of_mem {x : X} {s : set X} (y : X) : x ∈ s → x ∈ insert y s :=
assume h, or.inr h

theorem eq_or_mem_of_mem_insert {x a : X} {s : set X} : x ∈ insert a s → x = a ∨ x ∈ s :=
assume h, h

theorem mem_of_mem_insert_of_ne {x a : X} {s : set X} (xin : x ∈ insert a s) : x ≠ a → x ∈ s :=
or_resolve_right (eq_or_mem_of_mem_insert xin)

theorem mem_insert_eq (x a : X) (s : set X) : x ∈ insert a s = (x = a ∨ x ∈ s) :=
propext (iff.intro !eq_or_mem_of_mem_insert
  (or.rec (λH', (eq.substr H' !mem_insert)) !mem_insert_of_mem))

theorem insert_eq_of_mem {a : X} {s : set X} (H : a ∈ s) : insert a s = s :=
ext (λ x, eq.substr (mem_insert_eq x a s)
   (or_iff_right_of_imp (λH1, eq.substr H1 H)))

theorem insert.comm (x y : X) (s : set X) : insert x (insert y s) = insert y (insert x s) :=
ext (take a, by rewrite [*mem_insert_eq, propext !or.left_comm])

-- useful in proofs by induction
theorem forall_of_forall_insert {P : X → Prop} {a : X} {s : set X}
    (H : ∀ x, x ∈ insert a s → P x) :
  ∀ x, x ∈ s → P x :=
λ x xs, H x (!mem_insert_of_mem xs)

lemma bounded_forall_insert_iff {P : X → Prop} {a : X} {s : set X} :
  (∀₀x ∈ insert a s, P x) ↔ P a ∧ (∀₀x ∈ s, P x) :=
begin
  apply iff.intro, all_goals (intro H),
  { apply and.intro,
    { apply H, apply mem_insert },
    { intro x Hx, apply H, apply mem_insert_of_mem, assumption } },
  { intro x Hx, cases Hx with eq Hx,
    { cases eq, apply (and.elim_left H) },
    { apply (and.elim_right H), assumption } }
end

/- singleton -/

theorem mem_singleton_iff (a b : X) : a ∈ '{b} ↔ a = b :=
iff.intro
  (assume ainb, or.elim ainb (λ aeqb, aeqb) (λ f, false.elim f))
  (assume aeqb, or.inl aeqb)

theorem mem_singleton (a : X) : a ∈ '{a} := !mem_insert

theorem eq_of_mem_singleton {x y : X} (h : x ∈ '{y}) : x = y :=
or.elim (eq_or_mem_of_mem_insert h)
  (suppose x = y, this)
  (suppose x ∈ ∅, absurd this !not_mem_empty)

theorem mem_singleton_of_eq {x y : X} (H : x = y) : x ∈ '{y} :=
eq.symm H ▸ mem_singleton y

theorem insert_eq (x : X) (s : set X) : insert x s = '{x} ∪ s :=
ext (take y, iff.intro
  (suppose y ∈ insert x s,
    or.elim this (suppose y = x, or.inl (or.inl this)) (suppose y ∈ s, or.inr this))
  (suppose y ∈ '{x} ∪ s,
    or.elim this
      (suppose y ∈ '{x}, or.inl (eq_of_mem_singleton this))
      (suppose y ∈ s, or.inr this)))

theorem pair_eq_singleton (a : X) : '{a, a} = '{a} :=
by rewrite [insert_eq_of_mem !mem_singleton]

theorem singleton_ne_empty (a : X) : '{a} ≠ ∅ :=
begin
  intro H,
  apply not_mem_empty a,
  rewrite -H,
  apply mem_insert
end

/- separation -/

theorem mem_sep {s : set X} {P : X → Prop} {x : X} (xs : x ∈ s) (Px : P x) : x ∈ {x ∈ s | P x} :=
and.intro xs Px

theorem eq_sep_of_subset {s t : set X} (ssubt : s ⊆ t) : s = {x ∈ t | x ∈ s} :=
ext (take x, iff.intro
  (suppose x ∈ s, and.intro (ssubt this) this)
  (suppose x ∈ {x ∈ t | x ∈ s}, and.right this))

theorem mem_sep_iff {s : set X} {P : X → Prop} {x : X} : x ∈ {x ∈ s | P x} ↔ x ∈ s ∧ P x :=
!iff.refl

theorem sep_subset (s : set X) (P : X → Prop) : {x ∈ s | P x} ⊆ s :=
take x, assume H, and.left H

theorem forall_not_of_sep_empty {s : set X} {P : X → Prop} (H : {x ∈ s | P x} = ∅) : ∀₀ x ∈ s, ¬ P x :=
  take x, suppose x ∈ s, suppose P x,
  have x ∈ {x ∈ s | P x}, from and.intro `x ∈ s` this,
  show false, from ne_empty_of_mem this H

/- complement -/

definition compl (s : set X) : set X := {x | x ∉ s}
prefix `-` := compl

theorem mem_compl {s : set X} {x : X} (H : x ∉ s) : x ∈ -s := H

theorem not_mem_of_mem_compl {s : set X} {x : X} (H : x ∈ -s) : x ∉ s := H

theorem mem_compl_iff (s : set X) (x : X) : x ∈ -s ↔ x ∉ s := !iff.refl

theorem inter_compl_self (s : set X) : s ∩ -s = ∅ :=
ext (take x, !and_not_self_iff)

theorem compl_inter_self (s : set X) : -s ∩ s = ∅ :=
ext (take x, !not_and_self_iff)

/- some classical identities -/

section
  open classical

  theorem compl_empty : -(∅ : set X) = univ :=
  ext (take x, iff.intro (assume H, trivial) (assume H, not_false))

  theorem compl_union (s t : set X) : -(s ∪ t) = -s ∩ -t :=
  ext (take x, !not_or_iff_not_and_not)

  theorem compl_compl (s : set X) : -(-s) = s :=
  ext (take x, !not_not_iff)

  theorem compl_inter (s t : set X) : -(s ∩ t) = -s ∪ -t :=
  ext (take x, !not_and_iff_not_or_not)

  theorem compl_univ : -(univ : set X) = ∅ :=
  by rewrite [-compl_empty, compl_compl]

  theorem union_eq_compl_compl_inter_compl (s t : set X) : s ∪ t = -(-s ∩ -t) :=
  ext (take x, !or_iff_not_and_not)

  theorem inter_eq_compl_compl_union_compl (s t : set X) : s ∩ t = -(-s ∪ -t) :=
  ext (take x, !and_iff_not_or_not)

  theorem union_compl_self (s : set X) : s ∪ -s = univ :=
  ext (take x, !or_not_self_iff)

  theorem compl_union_self (s : set X) : -s ∪ s = univ :=
  ext (take x, !not_or_self_iff)

  theorem compl_comp_compl :
    #function compl ∘ compl = @id (set X) :=
  funext (λ s, compl_compl s)
end

/- set difference -/

definition diff (s t : set X) : set X := {x ∈ s | x ∉ t}
infix ` \ `:70 := diff

theorem mem_diff {s t : set X} {x : X} (H1 : x ∈ s) (H2 : x ∉ t) : x ∈ s \ t :=
and.intro H1 H2

theorem mem_of_mem_diff {s t : set X} {x : X} (H : x ∈ s \ t) : x ∈ s :=
and.left H

theorem not_mem_of_mem_diff {s t : set X} {x : X} (H : x ∈ s \ t) : x ∉ t :=
and.right H

theorem mem_diff_iff (s t : set X) (x : X) : x ∈ s \ t ↔ x ∈ s ∧ x ∉ t := !iff.refl

theorem mem_diff_eq (s t : set X) (x : X) : x ∈ s \ t = (x ∈ s ∧ x ∉ t) := rfl

theorem diff_eq (s t : set X) : s \ t = s ∩ -t := rfl

theorem union_diff_cancel {s t : set X} [dec : Π x, decidable (x ∈ s)] (H : s ⊆ t) : s ∪ (t \ s) = t :=
ext (take x, iff.intro
  (assume H1 : x ∈ s ∪ (t \ s), or.elim H1 (assume H2, !H H2) (assume H2, and.left H2))
  (assume H1 : x ∈ t,
    decidable.by_cases
      (suppose x ∈ s, or.inl this)
      (suppose x ∉ s, or.inr (and.intro H1 this))))

theorem diff_subset (s t : set X) : s \ t ⊆ s := inter_subset_left s _

theorem compl_eq_univ_diff (s : set X) : -s = univ \ s :=
ext (take x, iff.intro (assume H, and.intro trivial H) (assume H, and.right H))

/- powerset -/

definition powerset (s : set X) : set (set X) := {x : set X | x ⊆ s}
prefix `𝒫`:100 := powerset

theorem mem_powerset {x s : set X} (H : x ⊆ s) : x ∈ 𝒫 s := H

theorem subset_of_mem_powerset {x s : set X} (H : x ∈ 𝒫 s) : x ⊆ s := H

theorem mem_powerset_iff (x s : set X) : x ∈ 𝒫 s ↔ x ⊆ s := !iff.refl

/- function image -/

section image

variables {Y Z : Type}

abbreviation eq_on (f1 f2 : X → Y) (a : set X) : Prop :=
∀₀ x ∈ a, f1 x = f2 x

definition image (f : X → Y) (a : set X) : set Y := {y : Y | ∃x, x ∈ a ∧ f x = y}
infix ` ' ` := image

theorem image_eq_image_of_eq_on {f1 f2 : X → Y} {a : set X} (H1 : eq_on f1 f2 a) :
  f1 ' a = f2 ' a :=
ext (take y, iff.intro
  (assume H2,
    obtain x (H3 : x ∈ a ∧ f1 x = y), from H2,
    have H4 : x ∈ a, from and.left H3,
    have H5 : f2 x = y, from (H1 H4)⁻¹ ⬝ and.right H3,
    exists.intro x (and.intro H4 H5))
  (assume H2,
    obtain x (H3 : x ∈ a ∧ f2 x = y), from H2,
    have H4 : x ∈ a, from and.left H3,
    have H5 : f1 x = y, from (H1 H4) ⬝ and.right H3,
    exists.intro x (and.intro H4 H5)))

theorem mem_image {f : X → Y} {a : set X} {x : X} {y : Y}
  (H1 : x ∈ a) (H2 : f x = y) : y ∈ f ' a :=
exists.intro x (and.intro H1 H2)

theorem mem_image_of_mem (f : X → Y) {x : X} {a : set X} (H : x ∈ a) : f x ∈ image f a :=
mem_image H rfl

lemma image_comp (f : Y → Z) (g : X → Y) (a : set X) : (f ∘ g) ' a = f ' (g ' a) :=
ext (take z,
  iff.intro
    (assume Hz : z ∈ (f ∘ g) ' a,
      obtain x (Hx₁ : x ∈ a) (Hx₂ : f (g x) = z), from Hz,
      have Hgx : g x ∈ g ' a, from mem_image Hx₁ rfl,
      show z ∈ f ' (g ' a), from mem_image Hgx Hx₂)
    (assume Hz : z ∈ f ' (g 'a),
      obtain y (Hy₁ : y ∈ g ' a) (Hy₂ : f y = z), from Hz,
      obtain x (Hz₁ : x ∈ a) (Hz₂ : g x = y),      from Hy₁,
      show z ∈ (f ∘ g) ' a, from mem_image Hz₁ (Hz₂⁻¹ ▸ Hy₂)))

lemma image_subset {a b : set X} (f : X → Y) (H : a ⊆ b) : f ' a ⊆ f ' b :=
take y, assume Hy : y ∈ f ' a,
obtain x (Hx₁ : x ∈ a) (Hx₂ : f x = y), from Hy,
mem_image (H Hx₁) Hx₂

theorem image_union (f : X → Y) (s t : set X) :
  image f (s ∪ t) = image f s ∪ image f t :=
ext (take y, iff.intro
  (assume H : y ∈ image f (s ∪ t),
    obtain x [(xst : x ∈ s ∪ t) (fxy : f x = y)], from H,
    or.elim xst
      (assume xs, or.inl (mem_image xs fxy))
      (assume xt, or.inr (mem_image xt fxy)))
  (assume H : y ∈ image f s ∪ image f t,
    or.elim H
      (assume yifs : y ∈ image f s,
        obtain x [(xs : x ∈ s) (fxy : f x = y)], from yifs,
        mem_image (or.inl xs) fxy)
      (assume yift : y ∈ image f t,
        obtain x [(xt : x ∈ t) (fxy : f x = y)], from yift,
        mem_image (or.inr xt) fxy)))

theorem image_empty (f : X → Y) : image f ∅ = ∅ :=
eq_empty_of_forall_not_mem
  (take y, suppose y ∈ image f ∅,
    obtain x [(H : x ∈ empty) H'], from this,
    H)

theorem mem_image_compl (t : set X) (S : set (set X)) :
  t ∈ compl ' S ↔ -t ∈ S :=
iff.intro
  (suppose t ∈ compl ' S,
    obtain t' [(Ht' : t' ∈ S) (Ht : -t' = t)], from this,
    show -t ∈ S, by rewrite [-Ht, compl_compl]; exact Ht')
  (suppose -t ∈ S,
    have -(-t) ∈ compl 'S, from mem_image_of_mem compl this,
    show t ∈ compl 'S, from compl_compl t ▸ this)

theorem image_id (s : set X) : id ' s = s :=
ext (take x, iff.intro
  (suppose x ∈ id ' s,
    obtain x' [(Hx' : x' ∈ s) (x'eq : x' = x)], from this,
    show x ∈ s, by rewrite [-x'eq]; apply Hx')
  (suppose x ∈ s, mem_image_of_mem id this))

theorem compl_compl_image (S : set (set X)) :
  compl ' (compl ' S) = S :=
by rewrite [-image_comp, compl_comp_compl, image_id]

lemma bounded_forall_image_of_bounded_forall {f : X → Y} {S : set X} {P : Y → Prop}
  (H : ∀₀ x ∈ S, P (f x)) : ∀₀ y ∈ f ' S, P y :=
begin
  intro x' Hx;
  cases Hx with x Hx;
  cases Hx with Hx eq;
  rewrite (eq⁻¹);
  apply H;
  assumption
end

lemma bounded_forall_image_iff {f : X → Y} {S : set X} {P : Y → Prop} :
  (∀₀ y ∈ f ' S, P y) ↔ (∀₀ x ∈ S, P (f x)) :=
iff.intro (take H x Hx, H _ (!mem_image_of_mem `x ∈ S`)) bounded_forall_image_of_bounded_forall

lemma image_insert_eq {f : X → Y} {a : X} {S : set X} :
  f ' insert a S = insert (f a) (f ' S) :=
begin
  apply set.ext,
  intro x, apply iff.intro, all_goals (intros H),
  { cases H with y Hy, cases Hy with Hy eq, rewrite (eq⁻¹), cases Hy with y_eq,
    { rewrite y_eq, apply mem_insert },
    { apply mem_insert_of_mem, apply mem_image_of_mem, assumption } },
  { cases H with eq Hx,
    { rewrite eq, apply mem_image_of_mem, apply mem_insert },
    { cases Hx with y Hy, cases Hy with Hy eq,
      rewrite (eq⁻¹), apply mem_image_of_mem, apply mem_insert_of_mem, assumption } }
end

end image

/- collections of disjoint sets -/

definition disjoint_sets (S : set (set X)) : Prop := ∀ a b, a ∈ S → b ∈ S → a ≠ b → a ∩ b = ∅

theorem disjoint_sets_empty : disjoint_sets (∅ : set (set X)) :=
take a b, assume H, !not.elim !not_mem_empty H

theorem disjoint_sets_union {s t : set (set X)} (Hs : disjoint_sets s) (Ht : disjoint_sets t)
    (H : ∀ x y, x ∈ s ∧ y ∈ t → x ∩ y = ∅) :
  disjoint_sets (s ∪ t) :=
take a b, assume Ha Hb Hneq, or.elim Ha
 (assume H1, or.elim Hb
   (suppose b ∈ s, (Hs a b) H1 this Hneq)
   (suppose b ∈ t, (H a b) (and.intro H1 this)))
 (assume H2, or.elim Hb
   (suppose b ∈ s, !inter_comm ▸ ((H b a) (and.intro this H2)))
   (suppose b ∈ t, (Ht a b) H2 this Hneq))

theorem disjoint_sets_singleton (s : set (set X)) : disjoint_sets '{s} :=
take a b, assume Ha Hb  Hneq,
absurd (eq.trans ((iff.elim_left !mem_singleton_iff) Ha) ((iff.elim_left !mem_singleton_iff) Hb)⁻¹)
    Hneq

/- large unions -/

section large_unions
  variables {I : Type}
  variable a : set I
  variable b : I → set X
  variable C : set (set X)

  definition sUnion : set X := {x : X | ∃₀ c ∈ C, x ∈ c}
  definition sInter : set X := {x : X | ∀₀ c ∈ C, x ∈ c}

  prefix `⋃₀`:110 := sUnion
  prefix `⋂₀`:110 := sInter

  definition Union  : set X := {x : X | ∃i, x ∈ b i}
  definition Inter  : set X := {x : X | ∀i, x ∈ b i}

  notation `⋃` binders `, ` r:(scoped f, Union f) := r
  notation `⋂` binders `, ` r:(scoped f, Inter f) := r

  definition bUnion : set X := {x : X | ∃₀ i ∈ a, x ∈ b i}
  definition bInter : set X := {x : X | ∀₀ i ∈ a, x ∈ b i}

  notation `⋃` binders ` ∈ ` s `, ` r:(scoped f, bUnion s f) := r
  notation `⋂` binders ` ∈ ` s `, ` r:(scoped f, bInter s f) := r

end large_unions

-- sUnion and sInter: a collection (set) of sets

theorem mem_sUnion {x : X} {t : set X} {S : set (set X)} (Hx : x ∈ t) (Ht : t ∈ S) :
  x ∈ ⋃₀ S :=
exists.intro t (and.intro Ht Hx)

theorem not_mem_of_not_mem_sUnion {x : X} {t : set X} {S : set (set X)} (Hx : x ∉ ⋃₀ S) (Ht : t ∈ S) :
        x ∉ t :=
  suppose x ∈ t,
  have x ∈ ⋃₀ S, from mem_sUnion this Ht,
  show false, from Hx this

theorem mem_sInter {x : X} {t : set X} {S : set (set X)} (H : ∀₀ t ∈ S, x ∈ t) :
  x ∈ ⋂₀ S :=
H

theorem sInter_subset_of_mem {S : set (set X)} {t : set X} (tS : t ∈ S) :
  (⋂₀ S) ⊆ t :=
take x, assume H, H t tS

theorem subset_sUnion_of_mem {S : set (set X)} {t : set X} (tS : t ∈ S) :
  t ⊆ (⋃₀ S) :=
take x, assume H, exists.intro t (and.intro tS H)

theorem sUnion_empty : ⋃₀ ∅ = (∅ : set X) :=
eq_empty_of_forall_not_mem
  (take x, suppose x ∈ sUnion ∅,
    obtain t [(Ht : t ∈ ∅) Ht'], from this,
    show false, from Ht)

theorem sInter_empty : ⋂₀ ∅ = (univ : set X) :=
eq_univ_of_forall (λ x s H, false.elim H)

theorem sUnion_singleton (s : set X) : ⋃₀ '{s} = s :=
ext (take x, iff.intro
  (suppose x ∈ sUnion '{s},
    obtain u [(Hu : u ∈ '{s}) (xu : x ∈ u)], from this,
    have u = s, from eq_of_mem_singleton Hu,
    show x ∈ s, by rewrite -this; apply xu)
  (suppose x ∈ s,
    mem_sUnion this (mem_singleton s)))

theorem sInter_singleton (s : set X) : ⋂₀ '{s} = s :=
ext (take x, iff.intro
  (suppose x ∈ ⋂₀ '{s}, show x ∈ s, from this (mem_singleton s))
  (suppose x ∈ s, take u, suppose u ∈ '{s},
    show x ∈ u, by rewrite [eq_of_mem_singleton this]; assumption))

theorem sUnion_union (S T : set (set X)) : ⋃₀ (S ∪ T) = ⋃₀ S ∪ ⋃₀ T :=
ext (take x, iff.intro
  (suppose x ∈ sUnion (S ∪ T),
    obtain u [(Hu : u ∈ S ∪ T) (xu : x ∈ u)], from this,
    or.elim Hu
      (assume uS, or.inl (mem_sUnion xu uS))
      (assume uT, or.inr (mem_sUnion xu uT)))
  (suppose x ∈ sUnion S ∪ sUnion T,
    or.elim this
      (suppose x ∈ sUnion S,
        obtain u [(uS : u ∈ S) (xu : x ∈ u)], from this,
        mem_sUnion xu (or.inl uS))
      (suppose x ∈ sUnion T,
        obtain u [(uT : u ∈ T) (xu : x ∈ u)], from this,
        mem_sUnion xu (or.inr uT))))

theorem sInter_union (S T : set (set X)) : ⋂₀ (S ∪ T) = ⋂₀ S ∩ ⋂₀ T :=
ext (take x, iff.intro
  (assume H : x ∈ ⋂₀ (S ∪ T),
    and.intro (λ u uS, H (or.inl uS)) (λ u uT, H (or.inr uT)))
  (assume H : x ∈ ⋂₀ S ∩ ⋂₀ T,
    take u, suppose u ∈ S ∪ T, or.elim this (λ uS, and.left H u uS) (λ uT, and.right H u uT)))

theorem sUnion_insert (s : set X) (T : set (set X)) :
  ⋃₀ (insert s T) = s ∪ ⋃₀ T :=
by rewrite [insert_eq, sUnion_union, sUnion_singleton]

theorem sInter_insert (s : set X) (T : set (set X)) :
  ⋂₀ (insert s T) = s ∩ ⋂₀ T :=
by rewrite [insert_eq, sInter_union, sInter_singleton]

theorem compl_sUnion (S : set (set X)) :
  - ⋃₀ S = ⋂₀ (compl ' S) :=
ext (take x, iff.intro
  (assume H : x ∈ -(⋃₀ S),
    take t, suppose t ∈ compl ' S,
    obtain t' [(Ht' : t' ∈ S) (Ht : -t' = t)], from this,
    have x ∈ -t', from suppose x ∈ t', H (mem_sUnion this Ht'),
    show x ∈ t, by rewrite -Ht; apply this)
  (assume H : x ∈ ⋂₀ (compl ' S),
    suppose x ∈ ⋃₀ S,
    obtain t [(tS : t ∈ S) (xt : x ∈ t)], from this,
    have -t ∈ compl ' S, from mem_image_of_mem compl tS,
    have x ∈ -t, from H this,
    show false, proof this xt qed))

theorem sUnion_eq_compl_sInter_compl (S : set (set X)) :
  ⋃₀ S = - ⋂₀ (compl ' S) :=
by rewrite [-compl_compl (⋃₀ S), compl_sUnion]

theorem compl_sInter (S : set (set X)) :
  - ⋂₀ S = ⋃₀ (compl ' S) :=
by rewrite [sUnion_eq_compl_sInter_compl, compl_compl_image]

theorem sInter_eq_comp_sUnion_compl (S : set (set X)) :
   ⋂₀ S = -(⋃₀ (compl ' S)) :=
by rewrite [-compl_compl (⋂₀ S), compl_sInter]

theorem inter_sUnion_nonempty_of_inter_nonempty {s t : set X} {S : set (set X)} (Hs : t ∈ S) (Hne : s ∩ t ≠ ∅) :
        s ∩ ⋃₀ S ≠ ∅ :=
  obtain x Hsx Htx, from exists_mem_of_ne_empty Hne,
  have x ∈ ⋃₀ S, from mem_sUnion Htx Hs,
  ne_empty_of_mem (mem_inter Hsx this)

theorem sUnion_inter_nonempty_of_inter_nonempty {s t : set X} {S : set (set X)} (Hs : t ∈ S) (Hne : t ∩ s ≠ ∅) :
        (⋃₀ S) ∩ s ≠ ∅ :=
  obtain x Htx Hsx, from exists_mem_of_ne_empty Hne,
  have x ∈ ⋃₀ S, from mem_sUnion Htx Hs,
  ne_empty_of_mem (mem_inter this Hsx)

-- Union and Inter: a family of sets indexed by a type

theorem Union_subset {I : Type} {b : I → set X} {c : set X} (H : ∀ i, b i ⊆ c) : (⋃ i, b i) ⊆ c :=
take x,
suppose x ∈ Union b,
obtain i (Hi : x ∈ b i), from this,
show x ∈ c, from H i Hi

theorem subset_Inter {I : Type} {b : I → set X} {c : set X} (H : ∀ i, c ⊆ b i) : c ⊆ ⋂ i, b i :=
λ x cx i, H i cx

theorem Union_eq_sUnion_image {X I : Type} (s : I → set X) : (⋃ i, s i) = ⋃₀ (s ' univ) :=
ext (take x, iff.intro
  (suppose x ∈ Union s,
    obtain i (Hi : x ∈ s i), from this,
    mem_sUnion Hi (mem_image_of_mem s trivial))
  (suppose x ∈ sUnion (s ' univ),
    obtain t [(Ht : t ∈ s ' univ) (Hx : x ∈ t)], from this,
    obtain i [univi (Hi : s i = t)], from Ht,
    exists.intro i (show x ∈ s i, by rewrite Hi; apply Hx)))

theorem Inter_eq_sInter_image {X I : Type} (s : I → set X) : (⋂ i, s i) = ⋂₀ (s ' univ) :=
ext (take x, iff.intro
  (assume H : x ∈ Inter s,
    take t,
    suppose t ∈ s 'univ,
    obtain i [univi (Hi : s i = t)], from this,
    show x ∈ t, by rewrite -Hi; exact H i)
  (assume H : x ∈ ⋂₀ (s ' univ),
    take i,
    have s i ∈ s ' univ, from mem_image_of_mem s trivial,
    show x ∈ s i, from H this))

theorem compl_Union {X I : Type} (s : I → set X) : - (⋃ i, s i) = (⋂ i, - s i) :=
by rewrite [Union_eq_sUnion_image, compl_sUnion, -image_comp, -Inter_eq_sInter_image]

theorem compl_Inter {X I : Type} (s : I → set X) : -(⋂ i, s i) = (⋃ i, - s i) :=
by rewrite [Inter_eq_sInter_image, compl_sInter, -image_comp, -Union_eq_sUnion_image]

theorem Union_eq_comp_Inter_comp {X I : Type} (s : I → set X) : (⋃ i, s i) = - (⋂ i, - s i) :=
by rewrite [-compl_compl (⋃ i, s i), compl_Union]

theorem Inter_eq_comp_Union_comp {X I : Type} (s : I → set X) : (⋂ i, s i) = - (⋃ i, -s i) :=
by rewrite [-compl_compl (⋂ i, s i), compl_Inter]

lemma inter_distrib_Union_left {X I : Type} (s : I → set X) (a : set X) :
  a ∩ (⋃ i, s i) = ⋃ i, a ∩ s i :=
ext (take x, iff.intro
  (assume H, obtain i Hi, from and.elim_right H,
    have x ∈ a ∩ s i, from and.intro (and.elim_left H) Hi,
    show _, from exists.intro i this)
  (assume H, obtain i [xa xsi], from H,
   show _, from and.intro xa (exists.intro i xsi)))

section
  open classical

  lemma union_distrib_Inter_left {X I : Type} (s : I → set X) (a : set X) :
    a ∪ (⋂ i, s i) = ⋂ i, a ∪ s i :=
  ext (take x, iff.intro
    (assume H, or.elim H
      (assume H1, take i, or.inl H1)
      (assume H1, take i, or.inr (H1 i)))
    (assume H,
      by_cases
        (suppose x ∈ a, or.inl this)
        (suppose x ∉ a, or.inr (take i, or.resolve_left (H i) this))))
end

-- these are useful for turning binary union / intersection into countable ones

definition bin_ext (s t : set X) (n : ℕ) : set X :=
nat.cases_on n s (λ m, t)

lemma Union_bin_ext (s t : set X) : (⋃ i, bin_ext s t i) = s ∪ t :=
ext (take x, iff.intro
  (assume H,
    obtain i (Hi : x ∈ (bin_ext s t) i), from H,
    by cases i; apply or.inl Hi; apply or.inr Hi)
  (assume H,
    or.elim H
      (suppose x ∈ s, exists.intro 0 this)
      (suppose x ∈ t, exists.intro 1 this)))

lemma Inter_bin_ext (s t : set X) : (⋂ i, bin_ext s t i) = s ∩ t :=
ext (take x, iff.intro
  (assume H, and.intro (H 0) (H 1))
  (assume H, by intro i; cases i;
    apply and.elim_left H; apply and.elim_right H))

-- bUnion and bInter: a family of sets indexed by a set ("b" is for bounded)

variable {Y : Type}

theorem mem_bUnion {s : set X} {f : X → set Y} {x : X} {y : Y}
    (xs : x ∈ s) (yfx : y ∈ f x) :
  y ∈ ⋃ x ∈ s, f x :=
exists.intro x (and.intro xs yfx)

theorem mem_bInter {s : set X} {f : X → set Y} {y : Y} (H : ∀₀ x ∈ s, y ∈ f x) :
  y ∈ ⋂ x ∈ s, f x :=
H

theorem bUnion_subset {s : set X} {t : set Y} {f : X → set Y} (H : ∀₀ x ∈ s, f x ⊆ t) :
  (⋃ x ∈ s, f x) ⊆ t :=
take y, assume Hy,
obtain x [xs yfx], from Hy,
show y ∈ t, from H xs yfx

theorem subset_bInter {s : set X} {t : set Y} {f : X → set Y} (H : ∀₀ x ∈ s, t ⊆ f x) :
  t ⊆ ⋂ x ∈ s, f x :=
take y, assume yt, take x, assume xs, H xs yt

theorem subset_bUnion_of_mem {s : set X} {f : X → set Y} {x : X} (xs : x ∈ s) :
  f x ⊆ ⋃ x ∈ s, f x :=
take y, assume Hy, mem_bUnion xs Hy

theorem bInter_subset_of_mem {s : set X} {f : X → set Y} {x : X} (xs : x ∈ s) :
  (⋂ x ∈ s, f x) ⊆ f x :=
take y, assume Hy, Hy x xs

theorem bInter_empty (f : X → set Y) : (⋂ x ∈ (∅ : set X), f x) = univ :=
eq_univ_of_forall (take y x xine, absurd xine !not_mem_empty)

theorem bInter_singleton (a : X) (f : X → set Y) : (⋂ x ∈ '{a}, f x) = f a :=
ext (take y, iff.intro
  (assume H, H a !mem_singleton)
  (assume H, λ x xa, by rewrite [eq_of_mem_singleton xa]; apply H))

theorem bInter_union (s t : set X) (f : X → set Y) :
  (⋂ x ∈ s ∪ t, f x) = (⋂ x ∈ s, f x) ∩ (⋂ x ∈ t, f x) :=
ext (take y, iff.intro
  (assume H, and.intro (λ x xs, H x (or.inl xs)) (λ x xt, H x (or.inr xt)))
  (assume H, λ x xst, or.elim (xst) (λ xs, and.left H x xs) (λ xt, and.right H x xt)))

theorem bInter_insert (a : X) (s : set X) (f : X → set Y) :
  (⋂ x ∈ insert a s, f x) = f a ∩ (⋂ x ∈ s, f x) :=
by rewrite [insert_eq, bInter_union, bInter_singleton]

theorem bInter_pair (a b : X) (f : X → set Y) :
  (⋂ x ∈ '{a, b}, f x) = f a ∩ f b :=
by rewrite [*bInter_insert, bInter_empty, inter_univ]

theorem bUnion_empty (f : X → set Y) : (⋃ x ∈ (∅ : set X), f x) = ∅ :=
eq_empty_of_forall_not_mem (λ y H, obtain x [xine yfx], from H,
  !not_mem_empty xine)

theorem bUnion_singleton (a : X) (f : X → set Y) : (⋃ x ∈ '{a}, f x) = f a :=
ext (take y, iff.intro
  (assume H, obtain x [xina yfx], from H,
    show y ∈ f a, by rewrite [-eq_of_mem_singleton xina]; exact yfx)
  (assume H, exists.intro a (and.intro !mem_singleton H)))

theorem bUnion_union (s t : set X) (f : X → set Y) :
  (⋃ x ∈ s ∪ t, f x) = (⋃ x ∈ s, f x) ∪ (⋃ x ∈ t, f x) :=
ext (take y, iff.intro
  (assume H, obtain x [xst yfx], from H,
    or.elim xst
      (λ xs, or.inl (exists.intro x (and.intro xs yfx)))
      (λ xt, or.inr (exists.intro x (and.intro xt yfx))))
  (assume H, or.elim H
    (assume H1, obtain x [xs yfx], from H1,
      exists.intro x (and.intro (or.inl xs) yfx))
    (assume H1, obtain x [xt yfx], from H1,
      exists.intro x (and.intro (or.inr xt) yfx))))

theorem bUnion_insert (a : X) (s : set X) (f : X → set Y) :
  (⋃ x ∈ insert a s, f x) = f a ∪ (⋃ x ∈ s, f x) :=
by rewrite [insert_eq, bUnion_union, bUnion_singleton]

theorem bUnion_pair (a b : X) (f : X → set Y) :
  (⋃ x ∈ '{a, b}, f x) = f a ∪ f b :=
by rewrite [*bUnion_insert, bUnion_empty, union_empty]

end set


/- Homework 1.2: Basics — Proofs -/

/- Question 1: Drop and Take -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

#reduce drop 2 [2,4,6, 8]

/- 1.1. Define `take`. -/

/- To avoid bad surprises in the proofs, we recommend that you follow the same recursion pattern as
for `drop` above. -/

def take {α : Type} : ℕ → list α → list α
| 0             xs      :=      []
| (_ + 1)       []      :=      []
| (m + 1)  (x::xs) :=      [x] ++ take m xs

-- ZZZ: Jasmins simpler take, see last line
def take' {α : Type} : ℕ → list α → list α
| 0        xs           := []
| (_ + 1)  []           := []
| (m + 1)  (x::xs)      := x :: take m xs

#reduce take 0 [3, 7, 11]   -- expected: []
#reduce take 1 [3, 7, 11]   -- expected: [3]
#reduce take 2 [3, 7, 11]   -- expected: [3, 7]
#reduce take 3 [3, 7, 11]   -- expected: [3, 7, 11]
#reduce take 4 [3, 7, 11]   -- expected: [3, 7, 11]

#reduce take 3[]
-- when `#reduce` fails for some obscure reason, try `#eval`:
#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/- 1.2. Prove the following lemmas. Notice that they are registered as simp rules thanks to the
`@[simp]` attribute. -/
@[simp] lemma drop_nil {α : Type} : ∀(n : ℕ), drop n ([] : list α) = [] :=
begin
intros n,
induction n,
simp,
refl,
simp[drop]
end

@[simp] lemma drop_nil' {α : Type} : ∀(n : ℕ), drop n ([] : list α) = []
| 0 := by refl
| (_ + 1) := by refl

@[simp] lemma take_nil {α : Type} : ∀(n : ℕ), take n ([] : list α) = []:=
begin
intros n,
induction n,
simp,
refl,
simp[take]
end

/- 1.3. Follow the recursion pattern of `drop` and `take` to prove the following lemmas. In other
words, for each lemma, there should be three cases, and the third case will need to invoke the
induction hypothesis.

The first case is shown for `drop_drop`. Beware of the fact that there are three variables in the
`drop_drop` lemma (but only two arguments to `drop`). Hint: The `refl` tactic might be useful in the
third case of `drop_drop`.
-/

lemma drop_drop {α : Type} : ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
| (_ + 1) n []        := by simp
| (m + 1) n (x :: xs)       :=
begin
rw[<-add_assoc n m 1],
unfold drop,
simp[drop_drop m],
end

-- ZZZ: Jasmins solution
lemma drop_drop' {α : Type} : ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
| (_ + 1) n []        := by simp
| (m + 1) n (x :: xs)       :=
begin
rw[<-add_assoc n m 1],
unfold drop,
simp[drop, drop_drop' m]
end

lemma take_take {α : Type} : ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
| 0 xs                    := by refl
| (m + 1) xs              :=
begin
induction xs,
refl,
simp[take],
end

lemma take_drop {α : Type} : ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
| 0 xs := by simp[take, drop]
| (_ + 1) xs :=
begin
induction xs,
simp[take_drop],
unfold take,
unfold drop,
rw[<-xs_ih],
simp,
rw[xs_ih],
simp[take_drop]
end

-- ZZZ: Jasmins nicer solutions
lemma take_take' {α : Type} : ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, take_take' m xs]

lemma take_drop' {α : Type} : ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, drop, take_drop' m]

/- Question 2: Gauss's summation formula -/

/-- `sum_upto f n = f 0 + f 1 + ... + f n` -/
def sum_upto (f : ℕ → ℕ) : ℕ → ℕ
| 0       := f 0
| (m + 1) := sum_upto m + f (m + 1)

/- 2.1. Prove the following lemma, discovered by Carl Friedrich Gauss as a pupil.

Hints: The `ac_refl` tactic might be useful to reason about multiplication. The rules about `add`
and `mul` in `12_exercise.lean` exist with the same names about '+' and '*' in Lean's libraries. -/

lemma sum_upto_eq : ∀m : ℕ, 2 * sum_upto id m = m * (m + 1)
| 0 := by refl
| (m + 1) :=
begin
simp[mul_add, mul_comm],
rw[<-mul_comm m],
simp[sum_upto],
simp[mul_add],
simp[sum_upto_eq],
simp[mul_add],
simp[mul_comm]
end

-- ZZZ: consec simps can be combined into one
lemma sum_upto_eq' : ∀m : ℕ, 2 * sum_upto id m = m * (m + 1)
| 0               := by refl
| (m + 1)         := begin simp [sum_upto, mul_add, sum_upto_eq' m, add_mul], ac_refl end

/- 2.2. Prove the following property of `sum_upto`. -/

lemma sum_upto_mul (a : ℕ) (f : ℕ → ℕ) : ∀(n : ℕ), sum_upto (λi, a * f i) n = a * sum_upto f n
| 0 := by refl
| (m + 1) :=
begin
simp[sum_upto],
simp[sum_upto_mul],
simp[mul_add]
end


/- This is a short tutorial on lean for the Logic in Computer Science course at the university
of Ljubljana. -/

namespace logika_v_racunalnistvu

/- We typically want to be universe polymorphic in lean, so we introduce a universe variable u. -/

universes u v w

/- Definitions of inductive types are made using the inductive keyword. Different constructors
   are separated by |. -/

inductive list (A : Type u) : Type u
| nil : list
| cons : A → list → list

/- We open the namespace list, so that we can use nil and cons directly. -/

namespace list

/- We will now define some basic operations on lists. -/

/- Direct definitions are made using the definition keyword, followed by := -/

definition unit {A : Type u} (a : A) : list A :=
cons a nil

/- A shorthand for definition is def, which may also be used. -/

/- Since the type of lists is an inductive type, we can make inductive definitions on list
using pattern matching. The syntax is analogous to the syntax of the inductive type itself.
Note that in pattern matching definitions, we don't use := at the end of the specification. -/

def fold {A : Type u} {B : Type v} (b : B) (μ : A → B → B) : list A → B
| nil := b
| (cons a l) := μ a (fold l)

def functor_list {A : Type u} {B : Type v} (f : A → B) : list A → list B
| nil := nil
| (cons a x) := cons (f a) (functor_list x)

def length {A : Type u} : list A → ℕ :=
fold 0 (λ _ n, n + 1)

def sum_list_ℕ : list ℕ → ℕ :=
fold 0 (λ m n, m + n)

def concat {A : Type u} : list A → list A → list A :=
fold id (λ a f l, cons a (f l))

def flatten {A : Type u} : list (list A) → list A :=
fold nil concat

def reverse {A : Type u} : list A → list A
| nil := nil
| (cons a l) := concat (reverse l) (unit a)

/- We have now finished defining our basic operations on lists. Let us check by some examples
   that the operations indeed do what they are supposed to do. With your mouse, hover over the
   #reduce keyword to see what each term reduces to. -/

#reduce concat (cons 1 (cons 2 (cons 3 nil))) (cons 4 (cons 5 nil))

#reduce sum_list_ℕ (concat (cons 1 (cons 2 (cons 3 nil))) (cons 4 (cons 5 nil)))

#reduce reverse (concat (cons 1 (cons 2 (cons 3 nil))) (cons 4 (cons 5 nil)))

/- Of course, if you really want to know that your operations behave as expected, you should
   prove the relevant properties about them. This is what we will do next. -/

/- When proving theorems, we can also proceed by pattern matching. In a pattern matching argument
   we can recursively call the object we are defining on earlier instances.

   The arguments that we want to pattern-match on, must appear after the colon (:) in the
   specification of the theorem. -/

theorem identity_law_functor_list {A : Type u} :
    ∀ (x : list A), functor_list id x = x
| nil := rfl
| (cons a x) :=
    calc
    functor_list id (cons a x)
        = cons a (functor_list id x) : rfl
    ... = cons a x : by rw identity_law_functor_list

theorem composition_law_functor_list {A : Type u} {B : Type v} {C : Type w} (f : A → B) (g : B → C) :
    ∀ (x : list A), functor_list (g ∘ f) x = functor_list g (functor_list f x)
| nil := rfl
| (cons a x) :=
    calc
    functor_list (g ∘ f) (cons a x)
        = cons (g (f a)) (functor_list (g ∘ f) x) : rfl
    ... = cons (g (f a)) (functor_list g (functor_list f x)) : by rw composition_law_functor_list
    ... = functor_list g (functor_list f (cons a x)) : rfl

/- Next, we prove some properties concatenation. Concatenation of lists is an associative
   operation, and it satisfies the left and right unit laws.universe

   In order to prove associativity, we note that since concatenation is defined by induction
   on the left argument, we will again use induction on the left argument to prove this
   propoerty. The proof is presented by pattern matching.

   In the proof we will use the built-in equation compiler. We just calculate as if we were
   working on a sheet of paper, and each time we mention the reason why the equality holds. -/

theorem assoc_concat {A : Type u} :
    ∀ (x y z : list A), concat (concat x y) z = concat x (concat y z)
| nil _ _ := rfl
| (cons a l) y z :=
    calc
    concat (concat (cons a l) y) z
        = cons a (concat (concat l y) z) : by reflexivity
    ... = cons a (concat l (concat y z)) : by rw assoc_concat
    ... = concat (cons a l) (concat y z) : by reflexivity

theorem left_unit_law_concat {A : Type u} :
    ∀ (x : list A), concat nil x = x :=
    eq.refl

theorem right_unit_law_concat {A : Type u} :
    ∀ (x : list A), concat x nil = x
| nil := rfl
| (cons a x) :=
    show cons a (concat x nil) = cons a x,
    by rw right_unit_law_concat

/- Next, we prove the elementary properties of the length function. -/

theorem length_nil {A : Type u} :
    length (@nil A) = 0 := rfl

theorem length_unit {A : Type u} (a : A) :
    length (unit a) = 1 :=
    rfl

theorem length_concat {A : Type u} :
    ∀ (x y : list A), length (concat x y) = length x + length y
| nil y :=
    calc
    length (concat nil y)
        = length y : rfl
    ... = 0 + length y : by rw zero_add
    ... = length nil + length y : by rw length_nil
| (cons a x) y :=
    calc
    length (concat (cons a x) y)
        = length (concat x y) + 1 : rfl
    ... = (length x + length y) + 1 : by rw length_concat
    ... = (length x + 1) + length y : by rw nat.succ_add
    ... = (length (cons a x)) + length y : rfl

/- Next, we prove the elemenatary properties of the flatten function. -/

theorem flatten_unit {A : Type u} :
    ∀ (x : list A), flatten (unit x) = x :=
    right_unit_law_concat

theorem length_flatten {A : Type u} :
    ∀ (x : list (list A)), length (flatten x) = sum_list_ℕ (functor_list length x)
| nil := rfl
| (cons a x) :=
    calc
    length (flatten (cons a x))
        = length (concat a (flatten x)) : rfl
    ... = length a + length (flatten x) : by rw length_concat
    ... = length a + sum_list_ℕ (functor_list length x) : by rw length_flatten
    ... = sum_list_ℕ (functor_list length (cons a x)) : rfl

theorem flatten_concat {A : Type u} :
    ∀ (x y : list (list A)), flatten (concat x y) = concat (flatten x) (flatten y)
| nil y := rfl
| (cons a x) y :=
    calc
    flatten (concat (cons a x) y)
        = concat a (flatten (concat x y)) : rfl
    ... = concat a (concat (flatten x) (flatten y)) : by rw flatten_concat
    ... = concat (concat a (flatten x)) (flatten y) : by rw assoc_concat
    ... = concat (flatten (cons a x)) (flatten y) : rfl

theorem flatten_flatten {A : Type u} :
    ∀ (x : list (list (list A))), flatten (flatten x) = flatten (functor_list flatten x)
| nil := rfl
| (cons a x) :=
    calc
    flatten (flatten (cons a x))
        = flatten (concat a (flatten x)) : rfl
    ... = concat (flatten a) (flatten (flatten x)) : by rw flatten_concat
    ... = concat (flatten a) (flatten (functor_list flatten x)) : by rw flatten_flatten
    ... = flatten (functor_list flatten (cons a x)) : rfl

/- Next, we prove the elementary properties of list reversal. -/

theorem unit_reverse {A : Type u} (a : A) :
    reverse (unit a) = unit a := rfl

theorem length_reverse {A : Type u} :
    ∀ (x : list A), length (reverse x) = length x
| nil := rfl
| (cons a x) :=
    calc
    length (reverse (cons a x))
        = length (concat (reverse x) (unit a)) : rfl
    ... = length (reverse x) + length (unit a) : by rw length_concat
    ... = length (reverse x) + 1 : by rw length_unit
    ... = length x + 1 : by rw length_reverse
    ... = length (cons a x) : rfl

theorem reverse_concat {A : Type u} :
    ∀ (x y : list A), reverse (concat x y) = concat (reverse y) (reverse x)
| nil y :=
    calc
    reverse (concat nil y) = reverse y : by reflexivity
    ... = concat (reverse y) nil : by rw right_unit_law_concat
| (cons a x) y :=
    calc
    reverse (concat (cons a x) y)
        = concat (reverse (concat x y)) (unit a) : rfl
    ... = concat (concat (reverse y) (reverse x)) (unit a) : by rw reverse_concat
    ... = concat (reverse y) (concat (reverse x) (unit a)) : by rw assoc_concat
    ... = concat (reverse y) (reverse (cons a x)) : rfl

theorem reverse_flatten {A : Type u} :
    ∀ (x : list (list A)), reverse (flatten x) = flatten (reverse (functor_list reverse x))
| nil := rfl
| (cons a x) :=
    calc
    reverse (flatten (cons a x))
        = reverse (concat a (flatten x)) : rfl
    ... = concat (reverse (flatten x)) (reverse a) : by rw reverse_concat
    ... = concat (flatten (reverse (functor_list reverse x))) (reverse a) : by rw reverse_flatten
    ... = concat (flatten (reverse (functor_list reverse x))) (flatten (unit (reverse a))) : by rw flatten_unit
    ... = flatten (concat (reverse (functor_list reverse x)) (unit (reverse a))) : by rw flatten_concat
    ... = flatten (reverse (cons (reverse a) (functor_list reverse x))) : rfl
    ... = flatten (reverse (functor_list reverse (cons a x))) : rfl

theorem reverse_reverse {A : Type u} :
    ∀ (x : list A), reverse (reverse x) = x
| nil := rfl
| (cons a x) :=
    calc
    reverse (reverse (cons a x))
        = reverse (concat (reverse x) (unit a)) : rfl
    ... = concat (reverse (unit a)) (reverse (reverse x)) : by rw reverse_concat
    ... = concat (unit a) (reverse (reverse x)) : by rw unit_reverse
    ... = concat (unit a) x : by rw reverse_reverse
    ... = cons a x : rfl

/- The next topic of our study of lists is Heads and Tails -/

def head {A : Type u} : list A → list A
| nil := nil
| (cons a x) := unit a

/- Note that the type of head can't be list A → A, because we might apply head to the empty list
   In that case, we should allow for an exception. Instead of mapping to the coproduct A + 1, we
   make give head the type list A → list A. -/

def tail {A : Type u} : list A → list A
| nil := nil
| (cons a x) := x

/- If we concatenate the head with the tail, we get the original list back -/

def concat_head_tail {A : Type u} :
    ∀ (x : list A), concat (head x) (tail x) = x
| nil := rfl
| (cons a x) := rfl

theorem head_head {A : Type u} :
    ∀ (x : list A), head (head x) = head x
| nil := rfl
| (cons a x) := rfl

theorem head_concat {A : Type u} :
    ∀ (x y : list A), head (concat x y) = head (concat (head x) (head y))
| nil y :=
    calc
    head (concat nil y)
        = head y : rfl
    ... = head (head y) : by rw head_head
    ... = head (concat (head nil) (head y)) : rfl
| (cons a x) y := rfl

theorem tail_concat {A : Type u} :
    ∀ (x y : list A), tail (concat x y) = concat (tail x) (tail (concat (head x) y))
| nil y := rfl
| (cons a x) y :=
    calc
    tail (concat (cons a x) y)
        = tail (cons a (concat x y)) : rfl
    ... = tail (cons a (concat (tail (cons a x)) y)) : rfl
    ... = concat (tail (cons a x)) y : rfl
    ... = concat (tail (cons a x)) (tail (concat (head (cons a x)) y)) : rfl

/- Dual to taking the head of a list, we may take the last element of a list. -/

def last {A : Type u} : list A → list A
| nil := nil
| (cons a nil) := unit a
| (cons a (cons a' x')) := last (cons a' x')

/- The last element is of course the head of the reversed list. -/

theorem head_reverse {A : Type u} :
    ∀ (x : list A), head (reverse x) = last x
| nil := rfl
| (cons a nil) := rfl
| (cons a (cons a' x')) :=
    calc
    head (reverse (cons a (cons a' x')))
        = head (concat (reverse (cons a' x')) (unit a)) : rfl
    ... = head (concat (concat (reverse x') (unit a')) (unit a)) : rfl
    ... = head (concat (reverse x') (concat (unit a') (unit a))) : by rw assoc_concat
    ... = head (concat (head (reverse x')) (head (concat (unit a') (unit a)))) : by rw head_concat
    ... = head (concat (head (reverse x')) (head (unit a'))) : rfl
    ... = head (concat (reverse x') (unit a')) : by {symmetry, rw head_concat}
    ... = head (reverse (cons a' x')) : rfl
    ... = last (cons a' x') : by rw head_reverse
    ... = last (cons a (cons a' x')) : rfl

/- Dual to taking the tail of a list, we may remove the last element of the list. -/

def remove_last {A : Type u} : list A → list A
| nil := nil
| (cons a nil) := nil
| (cons a (cons a' x')) := cons a (remove_last (cons a' x'))

/- Removing the last element of the list is of course taking the reverse of the tail of the
   reverse. -/

theorem tail_concat' {A : Type u} :
    ∀ (x  y : list A),
    tail (concat x y) = concat (tail x) (tail (concat (last x) y))
| nil y := rfl
| (cons a nil) y := rfl
| (cons a (cons a' x')) y :=
    calc
    tail (concat (cons a (cons a' x')) y)
        = concat (cons a' x') y : rfl
    ... = cons a' (tail (concat (cons a' x') y)) : rfl
    ... = cons a' (concat (tail (cons a' x')) (tail (concat (last (cons a' x')) y))) : by rw tail_concat'
    ... = concat (cons a' x') (tail (concat (last (cons a' x')) y)) : rfl
    ... = concat (tail (cons a (cons a' x'))) (tail (concat (last (cons a (cons a' x'))) y)) : rfl

def cons' {A : Type u} (x : list A) (a : A) : list A :=
concat x (unit a)

theorem last_cons' {A : Type u} :
    ∀ (x : list A) (a : A), last (cons' x a) = unit a
| nil a := rfl
| (cons a' nil) a := rfl
| (cons a' (cons a'' x'')) a :=
    calc
    last (cons' (cons a' (cons a'' x'')) a)
        = last (cons a' (cons a'' (concat x'' (unit a)))) : rfl
    ... = last (cons a'' (concat x'' (unit a))) : rfl
    ... = last (cons' (cons a'' x'') a) : rfl
    ... = unit a : by rw last_cons'

theorem tail_reverse {A : Type u} :
    ∀ (x : list A), tail (reverse x) = reverse (remove_last x)
| nil := rfl
| (cons a nil) := rfl
| (cons a (cons a' x')) :=
    calc
    tail (reverse (cons a (cons a' x')))
        = tail (concat (reverse (cons a' x')) (unit a)) : rfl
    ... = concat
            ( tail (reverse (cons a' x')))
            ( tail (concat (last (reverse (cons a' x'))) (unit a))) : by rw tail_concat'
    ... = concat
            ( tail (reverse (cons a' x')))
            ( tail (concat (last (concat (reverse x') (unit a'))) (unit a))) : rfl
    ... = concat
            ( tail (reverse (cons a' x')))
            ( tail (concat (last (cons' (reverse x') a')) (unit a))) : rfl
    ... = concat
            ( tail (reverse (cons a' x')))
            ( tail (concat (unit a') (unit a))) : by rw last_cons'
    ... = concat (tail (reverse (cons a' x'))) (unit a) : rfl
    ... = concat (reverse (remove_last (cons a' x'))) (unit a) : by rw tail_reverse
    ... = reverse (cons a (remove_last (cons a' x'))) : rfl
    ... = reverse (remove_last (cons a (cons a' x'))) : rfl

theorem remove_last_reverse {A : Type u} (x : list A):
    remove_last (reverse x) = reverse (tail x) :=
calc
remove_last (reverse x)
    = reverse (reverse (remove_last (reverse x))) : by rw reverse_reverse
... = reverse (tail (reverse (reverse x))) : by rw tail_reverse
... = reverse (tail x) : by {symmetry, rw reverse_reverse}

end list

/- Next, we study lists of a fixed length. -/

inductive list_of_length (A : Type u) : ℕ → Type u
| nil : list_of_length 0
| cons : ∀ (n : ℕ), A → list_of_length n → list_of_length (n+1)

namespace list_of_length

theorem eq_nil {A : Type u} : ∀ (x : list_of_length A 0), x = nil
| nil := rfl

def functor {A : Type u} {B : Type v} (f : A → B) :
    ∀ (n : ℕ), list_of_length A n → list_of_length B n
| 0 nil := nil
| (n+1) (cons n' a x) := cons n' (f a) (functor n' x)

def head {A : Type u} :
    ∀ (n : ℕ), list_of_length A (n+1) → A
| n (cons n' a x) := a

def tail {A : Type u} :
    ∀ (n : ℕ), list_of_length A (n+1) → list_of_length A n
| n (cons n' a x) := x

/- Using lists of fixed length, we can define matrices. The type
   Matrix m n A is the type of matrices with m rows and n columns
   and with coefficients in A. -/

def Matrix (m n : ℕ) (A : Type u) : Type u :=
list_of_length (list_of_length A n) m

def top_row {A : Type u} {m n : ℕ} :
    Matrix (m+1) n A → list_of_length A n :=
head m

def tail_vertical {A : Type u} {m n : ℕ} :
    Matrix (m+1) n A → Matrix m n A :=
tail m

def left_column {A : Type u} {m n : ℕ} :
    Matrix m (n+1) A → list_of_length A m :=
functor (head n) m

def tail_horizontal {A : Type u} {m n : ℕ} :
    Matrix m (n+1) A → Matrix m n A :=
functor (tail n) m

/- Since matrices are rectangular, we have a horizontal as well as vertical empty matrices. -/

def nil_vertical {A : Type u} {n : ℕ} : Matrix 0 n A := nil

theorem eq_nil_vertical {A : Type u} :
    ∀ {n : ℕ} (x : Matrix 0 n A), x = nil_vertical
| 0 nil := rfl
| (n+1) nil := rfl

def nil_horizontal {A : Type u} : ∀ {m : ℕ}, Matrix m 0 A
| 0 := nil
| (m+1) := cons m nil nil_horizontal

theorem eq_nil_horizontal {A : Type u} :
    ∀ {m : ℕ} (x : Matrix m 0 A), x = nil_horizontal
| 0 nil := rfl
| (m+1) (cons m' nil M) :=
    calc
    cons m nil M
        = cons m nil nil_horizontal : by rw eq_nil_horizontal M
    ... = nil_horizontal : rfl

/- Similarly, there is a horizontal cons and a vertical cons. -/

/- cons_vertical adds a new row from the top. -/

def cons_vertical {A : Type u} {m n : ℕ} :
    list_of_length A n → Matrix m n A → Matrix (m+1) n A :=
    cons m

theorem top_row_cons_vertical
    {A : Type u} {m n : ℕ} (x : list_of_length A n) (M : Matrix m n A) :
    top_row (cons_vertical x M) = x :=
rfl

theorem left_colum_cons_vertical {A : Type u} :
    ∀ {m n : ℕ} (x : list_of_length A (n+1)) (M : Matrix m (n+1) A),
    left_column (cons_vertical x M) = cons m (head n x) (left_column M)
| m n (cons n' a x) M := rfl

theorem eta_vertical {A : Type u} :
    ∀ {m n : ℕ} (M : Matrix (m+1) n A),
    cons_vertical (top_row M) (tail_vertical M) = M
| m n (cons _ x M) := rfl

/- cons_horizontal adds a new column from the left. -/

def cons_horizontal {A : Type u} :
    ∀ {m n : ℕ}, list_of_length A m → Matrix m n A → Matrix m (n+1) A
| 0 n nil M := nil
| (m+1) n (cons m' a x) M :=
    cons m (cons n a (top_row M)) (cons_horizontal x (tail_vertical M))

theorem left_column_cons_horizontal {A : Type u} :
    ∀ {m n : ℕ} (x : list_of_length A m) (M : Matrix m n A),
    left_column (cons_horizontal x M) = x
| 0 n nil M := rfl
| (m+1) n (cons m' a x) M :=
    calc
    left_column (cons_horizontal (cons m' a x) M)
        = cons m a (left_column (cons_horizontal x (tail_vertical M))) : rfl
    ... = cons m a x : by rw left_column_cons_horizontal

theorem top_row_cons_horizontal {A : Type u} :
    ∀ {m n : ℕ} (x : list_of_length A (m+1)) (M : Matrix (m+1) n A),
    top_row (cons_horizontal x M) = cons n (head m x) (top_row M)
| m n (cons m' a x) (cons m'' y M) := rfl

theorem tail_vertical_cons_horizontal {A : Type} :
    ∀ {m n : ℕ} (x : list_of_length A (m+1)) (M : Matrix (m+1) n A),
    tail_vertical (cons_horizontal x M) = cons_horizontal (tail m x) (tail_vertical M)
| m n (cons m' a x) (cons m'' y M) := rfl

theorem eta_horizontal {A : Type u} :
    ∀ {m n : ℕ} (M : Matrix m (n+1) A),
    cons_horizontal (left_column M) (tail_horizontal M) = M
| 0 n nil := rfl
| (m+1) n (cons m' (cons n' a x) M) :=
    calc
    cons_horizontal (left_column (cons m (cons n a x) M)) (tail_horizontal (cons m (cons n a x) M))
        = cons m (cons n a x) (cons_horizontal (left_column M) (tail_horizontal M)) : rfl
    ... = cons m (cons n a x) M : by rw eta_horizontal M

/- Next we show that if we add a row from the top as well as a column from the left, then it
   doesn't matter in which order we do that. -/

theorem cons_horizontal_cons_vertical {A : Type u} :
    ∀ {m n : ℕ} (a : A) (x : list_of_length A n) (y : list_of_length A m) (M : Matrix m n A),
    cons_horizontal (cons m a y) (cons_vertical x M)
        = cons_vertical (cons n a x) (cons_horizontal y M)
| m n a x y M := rfl

/- We define the transposition of a matrix. -/

def transpose {A : Type u} :
    ∀ {m n : ℕ}, Matrix m n A → Matrix n m A
| 0 n M := nil_horizontal
| (m+1) n (cons m' x M) := cons_horizontal x (transpose M)

/- The following three theorems show how transpose interacts with the basic operations on
   matrices. These will help to show that transposition is an involution. -/

theorem transpose_nil {A : Type u} :
    ∀ {n : ℕ}, @transpose A 0 n nil = nil_horizontal
| 0 := rfl
| (n+1) := rfl

theorem transpose_cons_horizontal {A : Type u} :
    ∀ {m n : ℕ} (x : list_of_length A m) (M : Matrix m n A),
    transpose (cons_horizontal x M) = cons_vertical x (transpose M)
| 0 n nil M := rfl
| (m+1) n (cons m' a x) (cons m'' y M) :=
    calc
    transpose (cons_horizontal (cons m' a x) (cons m'' y M))
        = transpose (cons m (cons n a y) (cons_horizontal x M)) : rfl
    ... = cons_horizontal (cons n a y) (transpose (cons_horizontal x M)) : rfl
    ... = cons_horizontal (cons n a y) (cons_vertical x (transpose M)) : by rw transpose_cons_horizontal
    ... = cons_vertical (cons m a x) (transpose (cons m y M)) : by reflexivity

theorem transpose_cons_vertical {A : Type u} :
    ∀ {m n : ℕ} (x : list_of_length A n) (M : Matrix m n A),
    transpose (cons_vertical x M) = cons_horizontal x (transpose M)
| m n x M := rfl

/- We finally show that transposition is an involution. -/

theorem transpose_transpose {A : Type u} :
    ∀ (m n : ℕ) (M : Matrix m n A), transpose (transpose M) = M
| 0 0 nil := rfl
| 0 (n+1) nil := rfl
| (m+1) 0 M :=
    calc
    transpose (transpose M)
        = transpose nil : rfl
    ... = nil_horizontal : by rw transpose_nil
    ... = M : by rw eq_nil_horizontal M
| (m+1) (n+1) (cons _ x M) :=
    calc
    transpose (transpose (cons _ x M))
        = transpose (transpose (cons_vertical x M)) : rfl
    ... = transpose (cons_horizontal x (transpose M)) : by rw transpose_cons_vertical
    ... = cons_vertical x (transpose (transpose M)) : by rw transpose_cons_horizontal
    ... = cons_vertical x M : by rw transpose_transpose
    ... = cons _ x M : rfl

end list_of_length

end logika_v_racunalnistvu


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 1 : "implies" (`→`)

We learn about propositions, and implications `P → Q` between them. You can get
this arrow by typing `\to` or `\r`. Mathematicians usually write the
implication arrow as `P ⇒ Q` but Lean prefers a single arrow.

## The absolute basics

`P : Prop` means that `P` is a true-false statement. `h : P` means
that `h` is a proof that `P` is true, or you can regard `h` as an
assumption that `P` is true; logically these are the same. Stuff above
the `⊢` symbol is your assumptions. The statement to the right of it is
the goal. Your job is to prove the goal from the assumptions.

## Tactics you will need

To solve the levels on this sheet you will need to know how to use the
following tactics:

* `intro`
* `exact`
* `apply`

You can read the descriptions of these tactics in Part C of the course
notes.

## Worked examples

Click around in the proofs to see the tactic state (on the right) change.
The tactic is implemented and the state changes just before the comma.
I will use the following conventions: variables with capital
letters like `P`, `Q`, `R` denote propositions
(i.e. true/false statements) and variables whose names begin
with `h` like `h1` or `hP` are proofs or hypotheses.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.
variables (P Q R : Prop)

-- Here are some examples of `intro`, `exact` and `apply` being used.

-- Assume that `P` and `Q` and `R` are all true. Deduce that `P` is true.
example (hP : P) (hQ : Q) (hR : R) : P :=
begin
  -- note that `exact P` does *not* work. `P` is the proposition, `hP` is the proof.
  exact hP
end

-- Assume `Q` is true. Prove that `P → Q`.
example (hQ : Q) : P → Q :=
begin
  -- The goal is of the form `X → Y` so we can use `intro`
  intro h,
  -- now `h` is the hypothesis that `P` is true.
  -- Our goal is now the same as a hypothesis so we can use `exact`
  exact hQ,
  -- note `exact Q` doesn't work: `exact` takes the *term*, not the type.
end

-- Assume `P → Q` and `P` is true. Deduce `Q`.
example (h : P → Q) (hP : P) : Q :=
begin
  -- our goal is `⊢ Q` which matches with the conclusion of `h` so `apply` works
  apply h,
  -- now our goal has changed to `P` which is an assumption
  exact hP,
end

/-

## Examples for you to try

Delete the `sorry`s and replace them with comma-separated tactic proofs
using `intro`, `exact` and `apply`.

-/

/-- Every proposition implies itself. -/
example : P → P :=
begin
  intro h,
  exact h,
end

/-

Note that `→` is not associative: in general `P → (Q → R)` and `(P → Q) → R`
might not be equivalent. This is like subtraction on numbers -- in general
`a - (b - c)` and `(a - b) - c` might not be equal.

So if we write `P → Q → R` then we'd better know what this means.
The convention in Lean is that it means `P → (Q → R)`. If you think
about it, this means that to deduce `R` you will need to prove both `P`
and `Q`. In general to prove `P1 → P2 → P3 → ... Pn` you can assume
`P1`, `P2`,...,`P(n-1)` and then you have to prove `Pn`.

So the next level is asking you prove that `P → (Q → P)`.

-/
example : P → Q → P :=
begin
  intro h,
  intro q,
  exact h,
end

/-- If we know `P`, and we also know `P → Q`, we can deduce `Q`.
This is called "Modus Ponens" by logicians. -/
example : P → (P → Q) → Q :=
begin
  intro fish,
  intro bow,
  apply bow,
  exact fish,
end

/-- `→` is transitive. That is, if `P → Q` and `Q → R` are true, then
  so is `P → R`. -/
example : (P → Q) → (Q → R) → (P → R) :=
begin
  intro q,
  intro w,
  intro e,
  apply w,
  apply q,
  exact e,
end

-- If `h : P → Q → R` with goal `⊢ R` and you `apply h`, you'll get
-- two goals! Note that tactics operate on only the first goal.
example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  intro q,
  intro w,
  intro e,
  apply q,
  exact e,
  apply w,
  exact e,
end

/-

Here are some harder puzzles. If you're not into logic puzzles
and you feel like you understand `intro`, `exact` and `apply`
then you can just skip these and move onto the next sheet
in this section, where you'll learn some more tactics.

-/

variables (S T : Prop)

example : (P → R) → (S → Q) → (R → T) → (Q → R) → S → T :=
begin
  intros hPR hSQ hRT hQR hS,
  apply hRT, apply hQR, apply hSQ,
  exact hS,
end

example : (P → Q) → ((P → Q) → P) → Q :=
begin
  intros hPQ hPQP,
  apply hPQ, apply hPQP, exact hPQ,
end

example : ((P → Q) → R) → ((Q → R) → P) → ((R → P) → Q) → P :=
begin
  intros pqr qrp rpq,
  apply qrp,
  intro q,
  apply pqr,
  intro p,
  exact q,
end

example : ((Q → P) → P) → (Q → R) → (R → P) → P :=
begin
  intros qpp qr rp,
  apply qpp,
  intro q,
  apply rp,apply qr,
  exact q,
end

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

example :
  (((P → Q → Q) → ((P → Q) → Q)) → R) →
  ((((P → P) → Q) → (P → P → Q)) → R) →
  (((P → P → Q) → ((P → P) → Q)) → R) → R :=
begin
  intros q w e,
  apply w,intros ppq p p1,
  apply ppq,intro f,exact p,
end


/-
Copyright (c) 2022 Pim Otte. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller, Pim Otte
-/

import algebra.big_operators.fin
import data.nat.choose.sum
import data.nat.factorial.big_operators
import data.fin.vec_notation
import data.finset.sym
import data.finsupp.multiset

/-!
# Multinomial

This file defines the multinomial coefficient and several small lemma's for manipulating it.

## Main declarations

- `nat.multinomial`: the multinomial coefficient

## Main results

- `finest.sum_pow`: The expansion of `(s.sum x) ^ n` using multinomial coefficients

-/

open_locale big_operators nat
open_locale big_operators

namespace nat

variables {α : Type*} (s : finset α) (f : α → ℕ) {a b : α} (n : ℕ)

/-- The multinomial coefficient. Gives the number of strings consisting of symbols
from `s`, where `c ∈ s` appears with multiplicity `f c`.

Defined as `(∑ i in s, f i)! / ∏ i in s, (f i)!`.
-/
def multinomial : ℕ := (∑ i in s, f i)! / ∏ i in s, (f i)!

lemma multinomial_pos : 0 < multinomial s f := nat.div_pos
  (le_of_dvd (factorial_pos _) (prod_factorial_dvd_factorial_sum s f)) (prod_factorial_pos s f)

lemma multinomial_spec : (∏ i in s, (f i)!) * multinomial s f = (∑ i in s, f i)! :=
nat.mul_div_cancel' (prod_factorial_dvd_factorial_sum s f)

@[simp] lemma multinomial_nil : multinomial ∅ f = 1 := rfl

@[simp] lemma multinomial_singleton : multinomial {a} f = 1 :=
by simp [multinomial, nat.div_self (factorial_pos (f a))]

@[simp] lemma multinomial_insert_one [decidable_eq α] (h : a ∉ s) (h₁ : f a = 1) :
  multinomial (insert a s) f = (s.sum f).succ * multinomial s f :=
begin
  simp only [multinomial, one_mul, factorial],
  rw [finset.sum_insert h, finset.prod_insert h, h₁, add_comm, ←succ_eq_add_one, factorial_succ],
  simp only [factorial_one, one_mul, function.comp_app, factorial],
  rw nat.mul_div_assoc _ (prod_factorial_dvd_factorial_sum _ _),
end

lemma multinomial_insert [decidable_eq α] (h : a ∉ s) :
  multinomial (insert a s) f = (f a + s.sum f).choose (f a) * multinomial s f :=
begin
  rw choose_eq_factorial_div_factorial (le.intro rfl),
  simp only [multinomial, nat.add_sub_cancel_left, finset.sum_insert h, finset.prod_insert h,
    function.comp_app],
  rw [div_mul_div_comm ((f a).factorial_mul_factorial_dvd_factorial_add (s.sum f))
    (prod_factorial_dvd_factorial_sum _ _), mul_comm (f a)! (s.sum f)!, mul_assoc,
    mul_comm _ (s.sum f)!, nat.mul_div_mul _ _ (factorial_pos _)],
end

lemma multinomial_congr {f g : α → ℕ} (h : ∀ a ∈ s, f a = g a) :
  multinomial s f = multinomial s g :=
begin
  simp only [multinomial], congr' 1,
  { rw finset.sum_congr rfl h },
  { exact finset.prod_congr rfl (λ a ha, by rw h a ha) },
end

/-! ### Connection to binomial coefficients

When `nat.multinomial` is applied to a `finset` of two elements `{a, b}`, the
result a binomial coefficient. We use `binomial` in the names of lemmas that
involves `nat.multinomial {a, b}`.
-/

lemma binomial_eq [decidable_eq α] (h : a ≠ b) :
  multinomial {a, b} f = (f a + f b)! / ((f a)! * (f b)!) :=
by simp [multinomial, finset.sum_pair h, finset.prod_pair h]

lemma binomial_eq_choose [decidable_eq α] (h : a ≠ b) :
  multinomial {a, b} f = (f a + f b).choose (f a) :=
by simp [binomial_eq _ h, choose_eq_factorial_div_factorial (nat.le_add_right _ _)]

lemma binomial_spec [decidable_eq α] (hab : a ≠ b) :
  (f a)! * (f b)! * multinomial {a, b} f = (f a + f b)! :=
by simpa [finset.sum_pair hab, finset.prod_pair hab] using multinomial_spec {a, b} f

@[simp] lemma binomial_one [decidable_eq α] (h : a ≠ b) (h₁ : f a = 1) :
  multinomial {a, b} f = (f b).succ :=
by simp [multinomial_insert_one {b} f (finset.not_mem_singleton.mpr h) h₁]

lemma binomial_succ_succ [decidable_eq α] (h : a ≠ b) :
  multinomial {a, b} ((f.update a (f a).succ).update b (f b).succ) =
  multinomial {a, b} (f.update a (f a).succ) +
  multinomial {a, b} (f.update b (f b).succ) :=
begin
  simp only [binomial_eq_choose, function.update_apply, function.update_noteq,
    succ_add, add_succ, choose_succ_succ, h, ne.def, not_false_iff, function.update_same],
  rw if_neg h.symm,
  ring,
end

lemma succ_mul_binomial [decidable_eq α] (h : a ≠ b) :
  (f a + f b).succ * multinomial {a, b} f =
  (f a).succ * multinomial {a, b} (f.update a (f a).succ) :=
begin
  rw [binomial_eq_choose _ h, binomial_eq_choose _ h, mul_comm (f a).succ,
    function.update_same, function.update_noteq (ne_comm.mp h)],
  convert succ_mul_choose_eq (f a + f b) (f a),
  exact succ_add (f a) (f b),
end

/-! ### Simple cases -/

lemma multinomial_univ_two (a b : ℕ) : multinomial finset.univ ![a, b] = (a + b)! / (a! * b!) :=
by simp [multinomial, fin.sum_univ_two, fin.prod_univ_two]

lemma multinomial_univ_three (a b c : ℕ) : multinomial finset.univ ![a, b, c] =
  (a + b + c)! / (a! * b! * c!) :=
by simp [multinomial, fin.sum_univ_three, fin.prod_univ_three]

end nat

/-! ### Alternative definitions -/

namespace finsupp

variables {α : Type*}

/-- Alternative multinomial definition based on a finsupp, using the support
  for the big operations
-/
def multinomial (f : α →₀ ℕ) : ℕ := (f.sum $ λ _, id)! / f.prod (λ _ n, n!)

lemma multinomial_eq (f : α →₀ ℕ) : f.multinomial = nat.multinomial f.support f := rfl

end finsupp

namespace multiset

variables {α : Type*}

/-- Alternative definition of multinomial based on `multiset` delegating to the
  finsupp definition
-/
noncomputable def multinomial (m : multiset α) : ℕ := m.to_finsupp.multinomial

lemma multinomial_filter_ne [decidable_eq α] (a : α) (m : multiset α) :
  m.multinomial = m.card.choose (m.count a) * (m.filter ((≠) a)).multinomial :=
begin
  dsimp only [multinomial],
  convert finsupp.multinomial_update a _,
  { rw [← finsupp.card_to_multiset, m.to_finsupp_to_multiset] },
  { ext1 a', rw [to_finsupp_apply, count_filter, finsupp.coe_update],
    split_ifs,
    { rw [function.update_noteq h.symm, to_finsupp_apply] },
    { rw [not_ne_iff.1 h, function.update_same] } },
end

end multiset

namespace finset

/-! ### Multinomial theorem -/

variables {α : Type*} [decidable_eq α] (s : finset α) {R : Type*}

/--
  The multinomial theorem

  Proof is by induction on the number of summands.
-/
theorem sum_pow_of_commute [semiring R] (x : α → R)
  (hc : (s : set α).pairwise $ λ i j, commute (x i) (x j)) :
  ∀ n, (s.sum x) ^ n =
  ∑ k : s.sym n, k.1.1.multinomial * (k.1.1.map $ x).noncomm_prod
    (multiset.map_set_pairwise $ hc.mono $ mem_sym_iff.1 k.2) :=
begin
  induction s using finset.induction with a s ha ih,
  { rw sum_empty,
    rintro (_ | n),
    { rw [pow_zero, fintype.sum_subsingleton],
      swap, { exact ⟨0, or.inl rfl⟩ },
      convert (one_mul _).symm, apply nat.cast_one },
    { rw [pow_succ, zero_mul],
      apply (fintype.sum_empty _).symm,
      rw sym_empty, apply_instance } },
  intro n, specialize ih (hc.mono $ s.subset_insert a),
  rw [sum_insert ha, (commute.sum_right s _ _ $ λ b hb, _).add_pow, sum_range], swap,
  { exact hc (mem_insert_self a s) (mem_insert_of_mem hb) (ne_of_mem_of_not_mem hb ha).symm },
  simp_rw [ih, mul_sum, sum_mul, sum_sigma', univ_sigma_univ],
  refine (fintype.sum_equiv (sym_insert_equiv ha) _ _ $ λ m, _).symm,
  rw [m.1.1.multinomial_filter_ne a],
  conv in (m.1.1.map _) { rw [← m.1.1.filter_add_not ((=) a), multiset.map_add] },
  simp_rw [multiset.noncomm_prod_add, m.1.1.filter_eq, multiset.map_replicate, m.1.2],
  rw [multiset.noncomm_prod_eq_pow_card _ _ _ (λ _, multiset.eq_of_mem_replicate)],
  rw [multiset.card_replicate, nat.cast_mul, mul_assoc, nat.cast_comm],
  congr' 1, simp_rw [← mul_assoc, nat.cast_comm], refl,
end

theorem sum_pow [comm_semiring R] (x : α → R) (n : ℕ) :
  (s.sum x) ^ n = ∑ k in s.sym n, k.val.multinomial * (k.val.map x).prod :=
begin
  conv_rhs { rw ← sum_coe_sort },
  convert sum_pow_of_commute s x (λ _ _ _ _ _, mul_comm _ _) n,
  ext1, rw multiset.noncomm_prod_eq_prod, refl,
end

end finset


/-
Copyright (c) 2019 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudriashov
-/
import analysis.convex.combination
import analysis.convex.function

/-!
# Jensen's inequality and maximum principle for convex functions

In this file, we prove the finite Jensen inequality and the finite maximum principle for convex
functions. The integral versions are to be found in `analysis.convex.integral`.

## Main declarations

Jensen's inequalities:
* `convex_on.map_center_mass_le`, `convex_on.map_sum_le`: Convex Jensen's inequality. The image of a
  convex combination of points under a convex function is less than the convex combination of the
  images.
* `concave_on.le_map_center_mass`, `concave_on.le_map_sum`: Concave Jensen's inequality.

As corollaries, we get:
* `convex_on.exists_ge_of_mem_convex_hull `: Maximum principle for convex functions.
* `concave_on.exists_le_of_mem_convex_hull`: Minimum principle for concave functions.
-/

open finset linear_map set
open_locale big_operators classical convex pointwise

variables {𝕜 E F β ι : Type*}

/-! ### Jensen's inequality -/

section jensen
variables [linear_ordered_field 𝕜] [add_comm_group E] [ordered_add_comm_group β] [module 𝕜 E]
  [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} {t : finset ι} {w : ι → 𝕜} {p : ι → E}

/-- Convex **Jensen's inequality**, `finset.center_mass` version. -/
lemma convex_on.map_center_mass_le (hf : convex_on 𝕜 s f) (h₀ : ∀ i ∈ t, 0 ≤ w i)
  (h₁ : 0 < ∑ i in t, w i) (hmem : ∀ i ∈ t, p i ∈ s) :
  f (t.center_mass w p) ≤ t.center_mass w (f ∘ p) :=
begin
  have hmem' : ∀ i ∈ t, (p i, (f ∘ p) i) ∈ {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2},
    from λ i hi, ⟨hmem i hi, le_rfl⟩,
  convert (hf.convex_epigraph.center_mass_mem h₀ h₁ hmem').2;
    simp only [center_mass, function.comp, prod.smul_fst, prod.fst_sum,
      prod.smul_snd, prod.snd_sum],
end

/-- Concave **Jensen's inequality**, `finset.center_mass` version. -/
lemma concave_on.le_map_center_mass (hf : concave_on 𝕜 s f) (h₀ : ∀ i ∈ t, 0 ≤ w i)
  (h₁ : 0 < ∑ i in t, w i) (hmem : ∀ i ∈ t, p i ∈ s) :
  t.center_mass w (f ∘ p) ≤ f (t.center_mass w p) :=
@convex_on.map_center_mass_le 𝕜 E βᵒᵈ _ _ _ _ _ _ _ _ _ _ _ _ hf h₀ h₁ hmem

/-- Convex **Jensen's inequality**, `finset.sum` version. -/
lemma convex_on.map_sum_le (hf : convex_on 𝕜 s f) (h₀ : ∀ i ∈ t, 0 ≤ w i) (h₁ : ∑ i in t, w i = 1)
  (hmem : ∀ i ∈ t, p i ∈ s) :
  f (∑ i in t, w i • p i) ≤ ∑ i in t, w i • f (p i) :=
by simpa only [center_mass, h₁, inv_one, one_smul]
  using hf.map_center_mass_le h₀ (h₁.symm ▸ zero_lt_one) hmem

/-- Concave **Jensen's inequality**, `finset.sum` version. -/
lemma concave_on.le_map_sum (hf : concave_on 𝕜 s f) (h₀ : ∀ i ∈ t, 0 ≤ w i) (h₁ : ∑ i in t, w i = 1)
  (hmem : ∀ i ∈ t, p i ∈ s) :
  ∑ i in t, w i • f (p i) ≤ f (∑ i in t, w i • p i) :=
@convex_on.map_sum_le 𝕜 E βᵒᵈ _ _ _ _ _ _ _ _ _ _ _ _ hf h₀ h₁ hmem

end jensen

/-! ### Maximum principle -/

section maximum_principle
variables [linear_ordered_field 𝕜] [add_comm_group E] [linear_ordered_add_comm_group β]
  [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} {t : finset ι} {w : ι → 𝕜}
  {p : ι → E} {x : E}

lemma le_sup_of_mem_convex_hull {s : finset E} (hf : convex_on 𝕜 (convex_hull 𝕜 (s : set E)) f)
  (hx : x ∈ convex_hull 𝕜 (s : set E)) :
  f x ≤ s.sup' (coe_nonempty.1 $ convex_hull_nonempty_iff.1 ⟨x, hx⟩) f :=
begin
  obtain ⟨w, hw₀, hw₁, rfl⟩ := mem_convex_hull.1 hx,
  exact (hf.map_center_mass_le hw₀ (by positivity) $ subset_convex_hull _ _).trans
    (center_mass_le_sup hw₀ $ by positivity),
end

lemma inf_le_of_mem_convex_hull {s : finset E} (hf : concave_on 𝕜 (convex_hull 𝕜 (s : set E)) f)
  (hx : x ∈ convex_hull 𝕜 (s : set E)) :
  s.inf' (coe_nonempty.1 $ convex_hull_nonempty_iff.1 ⟨x, hx⟩) f ≤ f x :=
le_sup_of_mem_convex_hull hf.dual hx

/-- If a function `f` is convex on `s`, then the value it takes at some center of mass of points of
`s` is less than the value it takes on one of those points. -/
lemma convex_on.exists_ge_of_center_mass (h : convex_on 𝕜 s f)
  (hw₀ : ∀ i ∈ t, 0 ≤ w i) (hw₁ : 0 < ∑ i in t, w i) (hp : ∀ i ∈ t, p i ∈ s) :
  ∃ i ∈ t, f (t.center_mass w p) ≤ f (p i) :=
begin
  set y := t.center_mass w p,
  rsuffices ⟨i, hi, hfi⟩ : ∃ i ∈ t.filter (λ i, w i ≠ 0), w i • f y ≤ w i • (f ∘ p) i,
  { rw mem_filter at hi,
    exact ⟨i, hi.1, (smul_le_smul_iff_of_pos $ (hw₀ i hi.1).lt_of_ne hi.2.symm).1 hfi⟩ },
  have hw' : (0 : 𝕜) < ∑ i in filter (λ i, w i ≠ 0) t, w i := by rwa sum_filter_ne_zero,
  refine exists_le_of_sum_le (nonempty_of_sum_ne_zero hw'.ne') _,
  rw [←sum_smul, ←smul_le_smul_iff_of_pos (inv_pos.2 hw'), inv_smul_smul₀ hw'.ne',
    ←finset.center_mass, finset.center_mass_filter_ne_zero],
  exact h.map_center_mass_le hw₀ hw₁ hp,
  apply_instance,
end

/-- If a function `f` is concave on `s`, then the value it takes at some center of mass of points of
`s` is greater than the value it takes on one of those points. -/
lemma concave_on.exists_le_of_center_mass (h : concave_on 𝕜 s f)
  (hw₀ : ∀ i ∈ t, 0 ≤ w i) (hw₁ : 0 < ∑ i in t, w i) (hp : ∀ i ∈ t, p i ∈ s) :
  ∃ i ∈ t, f (p i) ≤ f (t.center_mass w p) :=
@convex_on.exists_ge_of_center_mass 𝕜 E βᵒᵈ _ _ _ _ _ _ _ _ _ _ _ _ h hw₀ hw₁ hp

/-- Maximum principle for convex functions. If a function `f` is convex on the convex hull of `s`,
then the eventual maximum of `f` on `convex_hull 𝕜 s` lies in `s`. -/
lemma convex_on.exists_ge_of_mem_convex_hull (hf : convex_on 𝕜 (convex_hull 𝕜 s) f) {x}
  (hx : x ∈ convex_hull 𝕜 s) : ∃ y ∈ s, f x ≤ f y :=
begin
  rw _root_.convex_hull_eq at hx,
  obtain ⟨α, t, w, p, hw₀, hw₁, hp, rfl⟩ := hx,
  rcases hf.exists_ge_of_center_mass hw₀ (hw₁.symm ▸ zero_lt_one)
    (λ i hi, subset_convex_hull 𝕜 s (hp i hi)) with ⟨i, hit, Hi⟩,
  exact ⟨p i, hp i hit, Hi⟩
end

/-- Minimum principle for concave functions. If a function `f` is concave on the convex hull of `s`,
then the eventual minimum of `f` on `convex_hull 𝕜 s` lies in `s`. -/
lemma concave_on.exists_le_of_mem_convex_hull (hf : concave_on 𝕜 (convex_hull 𝕜 s) f) {x}
  (hx : x ∈ convex_hull 𝕜 s) : ∃ y ∈ s, f y ≤ f x :=
@convex_on.exists_ge_of_mem_convex_hull 𝕜 E βᵒᵈ _ _ _ _ _ _ _ _ hf _ hx

end maximum_principle