/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.topology
import topology.basic
import order.directed

variables {E : Type*} [add_comm_group E] [module ℝ E] {s X Y : set E}

open set

--will be proven from the stuff about closure operators
lemma convex_hull_convex_hull_union :
  convex_hull (convex_hull X ∪ Y) = convex_hull (X ∪ Y) :=
subset.antisymm (convex_hull_min (union_subset (convex_hull_mono (subset_union_left X Y))
  (subset.trans (subset_convex_hull Y) (convex_hull_mono (subset_union_right X Y))))
  (convex_convex_hull _)) (convex_hull_mono (union_subset_union_left _ (subset_convex_hull _)))

--will be proven from the stuff about closure operators
lemma convex_hull_self_union_convex_hull :
  convex_hull (X ∪ convex_hull Y) = convex_hull (X ∪ Y) :=
begin
  rw [union_comm, union_comm X Y],
  exact convex_hull_convex_hull_union,
end

lemma eq_left_or_right_or_mem_open_segment_of_mem_segment {x y z : E} (hz : z ∈ segment x y) :
  z = x ∨ z = y ∨ z ∈ open_segment x y :=
begin
   obtain ⟨a, b, ha, hb, hab, hz⟩ := hz,
  by_cases ha' : a = 0,
  swap,
  by_cases hb' : b = 0,
  swap,
  { right, right, exact ⟨a, b, ha.lt_of_ne (ne.symm ha'), hb.lt_of_ne (ne.symm hb'), hab, hz⟩ },
  all_goals { simp only [*, add_zero, not_not, one_smul, zero_smul, zero_add, rfl] at *},
  { left,
    refl },
  right,
  left,
  refl,
end

lemma convex_hull_pair {a b : E} :
  convex_hull {a, b} = (segment a b) := sorry

--TODO: Generalise to LCTVS
variables [normed_group E] [normed_space ℝ E] {x : E} {A B : set E}


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Defines bounded lattice type class hierarchy.

Includes the Prop and fun instances.
-/
import order.lattice
import data.option.basic
import tactic.pi_instances
import logic.nontrivial

set_option old_structure_cmd true

universes u v

variables {α : Type u} {β : Type v}

/-- Typeclass for the `⊤` (`\top`) notation -/
class has_top (α : Type u) := (top : α)
/-- Typeclass for the `⊥` (`\bot`) notation -/
class has_bot (α : Type u) := (bot : α)

notation `⊤` := has_top.top
notation `⊥` := has_bot.bot

attribute [pattern] has_bot.bot has_top.top

/-- An `order_top` is a partial order with a greatest element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_top (α : Type u) extends has_top α, partial_order α :=
(le_top : ∀ a : α, a ≤ ⊤)

section order_top
variables [order_top α] {a b : α}

@[simp] theorem le_top : a ≤ ⊤ :=
order_top.le_top a

theorem top_unique (h : ⊤ ≤ a) : a = ⊤ :=
le_antisymm le_top h

-- TODO: delete in favor of the next?
theorem eq_top_iff : a = ⊤ ↔ ⊤ ≤ a :=
⟨assume eq, eq.symm ▸ le_refl ⊤, top_unique⟩

@[simp] theorem top_le_iff : ⊤ ≤ a ↔ a = ⊤ :=
⟨top_unique, λ h, h.symm ▸ le_refl ⊤⟩

@[simp] theorem not_top_lt : ¬ ⊤ < a :=
assume h, lt_irrefl a (lt_of_le_of_lt le_top h)

theorem eq_top_mono (h : a ≤ b) (h₂ : a = ⊤) : b = ⊤ :=
top_le_iff.1 $ h₂ ▸ h

lemma lt_top_iff_ne_top : a < ⊤ ↔ a ≠ ⊤ :=
begin
  haveI := classical.dec_eq α,
  haveI : decidable (⊤ ≤ a) := decidable_of_iff' _ top_le_iff,
  by simp [-top_le_iff, lt_iff_le_not_le, not_iff_not.2 (@top_le_iff _ _ a)]
end

lemma ne_top_of_lt (h : a < b) : a ≠ ⊤ :=
lt_top_iff_ne_top.1 $ lt_of_lt_of_le h le_top

theorem ne_top_of_le_ne_top {a b : α} (hb : b ≠ ⊤) (hab : a ≤ b) : a ≠ ⊤ :=
assume ha, hb $ top_unique $ ha ▸ hab

lemma eq_top_of_maximal (h : ∀ b, ¬ a < b) : a = ⊤ :=
or.elim (lt_or_eq_of_le le_top) (λ hlt, absurd hlt (h ⊤)) (λ he, he)

end order_top

lemma strict_mono.top_preimage_top' [linear_order α] [order_top β]
  {f : α → β} (H : strict_mono f) {a} (h_top : f a = ⊤) (x : α) :
  x ≤ a :=
H.top_preimage_top (λ p, by { rw h_top, exact le_top }) x

theorem order_top.ext_top {α} {A B : order_top α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) :
  (by haveI := A; exact ⊤ : α) = ⊤ :=
top_unique $ by rw ← H; apply le_top

theorem order_top.ext {α} {A B : order_top α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  have := partial_order.ext H,
  have tt := order_top.ext_top H,
  casesI A, casesI B,
  injection this; congr'
end

/-- An `order_bot` is a partial order with a least element.
  (We could state this on preorders, but then it wouldn't be unique
  so distinguishing one would seem odd.) -/
class order_bot (α : Type u) extends has_bot α, partial_order α :=
(bot_le : ∀ a : α, ⊥ ≤ a)

section order_bot
variables [order_bot α] {a b : α}

@[simp] theorem bot_le : ⊥ ≤ a := order_bot.bot_le a

theorem bot_unique (h : a ≤ ⊥) : a = ⊥ :=
le_antisymm h bot_le

-- TODO: delete?
theorem eq_bot_iff : a = ⊥ ↔ a ≤ ⊥ :=
⟨assume eq, eq.symm ▸ le_refl ⊥, bot_unique⟩

@[simp] theorem le_bot_iff : a ≤ ⊥ ↔ a = ⊥ :=
⟨bot_unique, assume h, h.symm ▸ le_refl ⊥⟩

@[simp] theorem not_lt_bot : ¬ a < ⊥ :=
assume h, lt_irrefl a (lt_of_lt_of_le h bot_le)

theorem ne_bot_of_le_ne_bot {a b : α} (hb : b ≠ ⊥) (hab : b ≤ a) : a ≠ ⊥ :=
assume ha, hb $ bot_unique $ ha ▸ hab

theorem eq_bot_mono (h : a ≤ b) (h₂ : b = ⊥) : a = ⊥ :=
le_bot_iff.1 $ h₂ ▸ h

lemma bot_lt_iff_ne_bot : ⊥ < a ↔ a ≠ ⊥ :=
begin
  haveI := classical.dec_eq α,
  haveI : decidable (a ≤ ⊥) := decidable_of_iff' _ le_bot_iff,
  simp [-le_bot_iff, lt_iff_le_not_le, not_iff_not.2 (@le_bot_iff _ _ a)]
end

lemma ne_bot_of_gt (h : a < b) : b ≠ ⊥ :=
bot_lt_iff_ne_bot.1 $ lt_of_le_of_lt bot_le h

lemma eq_bot_of_minimal (h : ∀ b, ¬ b < a) : a = ⊥ :=
or.elim (lt_or_eq_of_le bot_le) (λ hlt, absurd hlt (h ⊥)) (λ he, he.symm)

end order_bot

lemma strict_mono.bot_preimage_bot' [linear_order α] [order_bot β]
  {f : α → β} (H : strict_mono f) {a} (h_bot : f a = ⊥) (x : α) :
  a ≤ x :=
H.bot_preimage_bot (λ p, by { rw h_bot, exact bot_le }) x

theorem order_bot.ext_bot {α} {A B : order_bot α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) :
  (by haveI := A; exact ⊥ : α) = ⊥ :=
bot_unique $ by rw ← H; apply bot_le

theorem order_bot.ext {α} {A B : order_bot α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  have := partial_order.ext H,
  have tt := order_bot.ext_bot H,
  casesI A, casesI B,
  injection this; congr'
end

/-- A `semilattice_sup_top` is a semilattice with top and join. -/
class semilattice_sup_top (α : Type u) extends order_top α, semilattice_sup α

section semilattice_sup_top
variables [semilattice_sup_top α] {a : α}

@[simp] theorem top_sup_eq : ⊤ ⊔ a = ⊤ :=
sup_of_le_left le_top

@[simp] theorem sup_top_eq : a ⊔ ⊤ = ⊤ :=
sup_of_le_right le_top

end semilattice_sup_top

/-- A `semilattice_sup_bot` is a semilattice with bottom and join. -/
class semilattice_sup_bot (α : Type u) extends order_bot α, semilattice_sup α

section semilattice_sup_bot
variables [semilattice_sup_bot α] {a b : α}

@[simp] theorem bot_sup_eq : ⊥ ⊔ a = a :=
sup_of_le_right bot_le

@[simp] theorem sup_bot_eq : a ⊔ ⊥ = a :=
sup_of_le_left bot_le

@[simp] theorem sup_eq_bot_iff : a ⊔ b = ⊥ ↔ (a = ⊥ ∧ b = ⊥) :=
by rw [eq_bot_iff, sup_le_iff]; simp

end semilattice_sup_bot

instance nat.semilattice_sup_bot : semilattice_sup_bot ℕ :=
{ bot := 0, bot_le := nat.zero_le, .. nat.distrib_lattice }

/-- A `semilattice_inf_top` is a semilattice with top and meet. -/
class semilattice_inf_top (α : Type u) extends order_top α, semilattice_inf α

section semilattice_inf_top
variables [semilattice_inf_top α] {a b : α}

@[simp] theorem top_inf_eq : ⊤ ⊓ a = a :=
inf_of_le_right le_top

@[simp] theorem inf_top_eq : a ⊓ ⊤ = a :=
inf_of_le_left le_top

@[simp] theorem inf_eq_top_iff : a ⊓ b = ⊤ ↔ (a = ⊤ ∧ b = ⊤) :=
by rw [eq_top_iff, le_inf_iff]; simp

end semilattice_inf_top

/-- A `semilattice_inf_bot` is a semilattice with bottom and meet. -/
class semilattice_inf_bot (α : Type u) extends order_bot α, semilattice_inf α

section semilattice_inf_bot
variables [semilattice_inf_bot α] {a : α}

@[simp] theorem bot_inf_eq : ⊥ ⊓ a = ⊥ :=
inf_of_le_left bot_le

@[simp] theorem inf_bot_eq : a ⊓ ⊥ = ⊥ :=
inf_of_le_right bot_le

end semilattice_inf_bot

/- Bounded lattices -/

/-- A bounded lattice is a lattice with a top and bottom element,
  denoted `⊤` and `⊥` respectively. This allows for the interpretation
  of all finite suprema and infima, taking `inf ∅ = ⊤` and `sup ∅ = ⊥`. -/
class bounded_lattice (α : Type u) extends lattice α, order_top α, order_bot α

@[priority 100] -- see Note [lower instance priority]
instance semilattice_inf_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
  semilattice_inf_top α :=
{ le_top := assume x, @le_top α _ x, ..bl }

@[priority 100] -- see Note [lower instance priority]
instance semilattice_inf_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
  semilattice_inf_bot α :=
{ bot_le := assume x, @bot_le α _ x, ..bl }

@[priority 100] -- see Note [lower instance priority]
instance semilattice_sup_top_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
  semilattice_sup_top α :=
{ le_top := assume x, @le_top α _ x, ..bl }

@[priority 100] -- see Note [lower instance priority]
instance semilattice_sup_bot_of_bounded_lattice (α : Type u) [bl : bounded_lattice α] :
  semilattice_sup_bot α :=
{ bot_le := assume x, @bot_le α _ x, ..bl }

theorem bounded_lattice.ext {α} {A B : bounded_lattice α}
  (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y) : A = B :=
begin
  have H1 : @bounded_lattice.to_lattice α A =
             @bounded_lattice.to_lattice α B := lattice.ext H,
  have H2 := order_bot.ext H,
  have H3 : @bounded_lattice.to_order_top α A =
             @bounded_lattice.to_order_top α B := order_top.ext H,
  have tt := order_bot.ext_bot H,
  casesI A, casesI B,
  injection H1; injection H2; injection H3; congr'
end

/-- A bounded distributive lattice is exactly what it sounds like. -/
class bounded_distrib_lattice α extends distrib_lattice α, bounded_lattice α

lemma inf_eq_bot_iff_le_compl {α : Type u} [bounded_distrib_lattice α] {a b c : α}
  (h₁ : b ⊔ c = ⊤) (h₂ : b ⊓ c = ⊥) : a ⊓ b = ⊥ ↔ a ≤ c :=
⟨assume : a ⊓ b = ⊥,
  calc a ≤ a ⊓ (b ⊔ c) : by simp [h₁]
    ... = (a ⊓ b) ⊔ (a ⊓ c) : by simp [inf_sup_left]
    ... ≤ c : by simp [this, inf_le_right],
  assume : a ≤ c,
  bot_unique $
    calc a ⊓ b ≤ b ⊓ c : by { rw [inf_comm], exact inf_le_inf_left _ this }
      ... = ⊥ : h₂⟩

/- Prop instance -/
instance bounded_distrib_lattice_Prop : bounded_distrib_lattice Prop :=
{ le           := λa b, a → b,
  le_refl      := assume _, id,
  le_trans     := assume a b c f g, g ∘ f,
  le_antisymm  := assume a b Hab Hba, propext ⟨Hab, Hba⟩,

  sup          := or,
  le_sup_left  := @or.inl,
  le_sup_right := @or.inr,
  sup_le       := assume a b c, or.rec,

  inf          := and,
  inf_le_left  := @and.left,
  inf_le_right := @and.right,
  le_inf       := assume a b c Hab Hac Ha, and.intro (Hab Ha) (Hac Ha),
  le_sup_inf   := assume a b c H, or_iff_not_imp_left.2 $
    λ Ha, ⟨H.1.resolve_left Ha, H.2.resolve_left Ha⟩,

  top          := true,
  le_top       := assume a Ha, true.intro,

  bot          := false,
  bot_le       := @false.elim }

noncomputable instance Prop.linear_order : linear_order Prop :=
{ le_total := by intros p q; change (p → q) ∨ (q → p); tauto!,
  decidable_le := classical.dec_rel _,
  .. (_ : partial_order Prop) }

@[simp]
lemma le_iff_imp {p q : Prop} : p ≤ q ↔ (p → q) := iff.rfl

section logic
variable [preorder α]

theorem monotone_and {p q : α → Prop} (m_p : monotone p) (m_q : monotone q) :
  monotone (λx, p x ∧ q x) :=
assume a b h, and.imp (m_p h) (m_q h)
-- Note: by finish [monotone] doesn't work

theorem monotone_or {p q : α → Prop} (m_p : monotone p) (m_q : monotone q) :
  monotone (λx, p x ∨ q x) :=
assume a b h, or.imp (m_p h) (m_q h)
end logic

instance pi.order_bot {α : Type*} {β : α → Type*} [∀ a, order_bot $ β a]  : order_bot (Π a, β a) :=
{ bot := λ _, ⊥,
  bot_le := λ x a, bot_le,
  .. pi.partial_order }

/- Function lattices -/

instance pi.has_sup {ι : Type*} {α : ι → Type*} [Π i, has_sup (α i)] : has_sup (Π i, α i) :=
⟨λ f g i, f i ⊔ g i⟩

@[simp] lemma sup_apply {ι : Type*} {α : ι → Type*} [Π i, has_sup (α i)] (f g : Π i, α i) (i : ι) :
  (f ⊔ g) i = f i ⊔ g i :=
rfl

instance pi.has_inf {ι : Type*} {α : ι → Type*} [Π i, has_inf (α i)] : has_inf (Π i, α i) :=
⟨λ f g i, f i ⊓ g i⟩

@[simp] lemma inf_apply {ι : Type*} {α : ι → Type*} [Π i, has_inf (α i)] (f g : Π i, α i) (i : ι) :
  (f ⊓ g) i = f i ⊓ g i :=
rfl

instance pi.has_bot {ι : Type*} {α : ι → Type*} [Π i, has_bot (α i)] : has_bot (Π i, α i) :=
⟨λ i, ⊥⟩

@[simp] lemma bot_apply {ι : Type*} {α : ι → Type*} [Π i, has_bot (α i)] (i : ι) :
  (⊥ : Π i, α i) i = ⊥ :=
rfl

instance pi.has_top {ι : Type*} {α : ι → Type*} [Π i, has_top (α i)] : has_top (Π i, α i) :=
⟨λ i, ⊤⟩

@[simp] lemma top_apply {ι : Type*} {α : ι → Type*} [Π i, has_top (α i)] (i : ι) :
  (⊤ : Π i, α i) i = ⊤ :=
rfl

instance pi.semilattice_sup {ι : Type*} {α : ι → Type*} [Π i, semilattice_sup (α i)] :
  semilattice_sup (Π i, α i) :=
by refine_struct { sup := (⊔), .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.semilattice_inf {ι : Type*} {α : ι → Type*} [Π i, semilattice_inf (α i)] :
  semilattice_inf (Π i, α i) :=
by refine_struct { inf := (⊓), .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.semilattice_inf_bot {ι : Type*} {α : ι → Type*} [Π i, semilattice_inf_bot (α i)] :
  semilattice_inf_bot (Π i, α i) :=
by refine_struct { inf := (⊓), bot := ⊥, .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.semilattice_inf_top {ι : Type*} {α : ι → Type*} [Π i, semilattice_inf_top (α i)] :
  semilattice_inf_top (Π i, α i) :=
by refine_struct { inf := (⊓), top := ⊤, .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.semilattice_sup_bot {ι : Type*} {α : ι → Type*} [Π i, semilattice_sup_bot (α i)] :
  semilattice_sup_bot (Π i, α i) :=
by refine_struct { sup := (⊔), bot := ⊥, .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.semilattice_sup_top {ι : Type*} {α : ι → Type*} [Π i, semilattice_sup_top (α i)] :
  semilattice_sup_top (Π i, α i) :=
by refine_struct { sup := (⊔), top := ⊤, .. pi.partial_order }; tactic.pi_instance_derive_field

instance pi.lattice {ι : Type*} {α : ι → Type*} [Π i, lattice (α i)] : lattice (Π i, α i) :=
{ .. pi.semilattice_sup, .. pi.semilattice_inf }

instance pi.bounded_lattice {ι : Type*} {α : ι → Type*} [Π i, bounded_lattice (α i)] :
  bounded_lattice (Π i, α i) :=
{ .. pi.semilattice_sup_top, .. pi.semilattice_inf_bot }

lemma eq_bot_of_bot_eq_top {α : Type*} [bounded_lattice α] (hα : (⊥ : α) = ⊤) (x : α) :
  x = (⊥ : α) :=
eq_bot_mono le_top (eq.symm hα)

lemma eq_top_of_bot_eq_top {α : Type*} [bounded_lattice α] (hα : (⊥ : α) = ⊤) (x : α) :
  x = (⊤ : α) :=
eq_top_mono bot_le hα

lemma subsingleton_of_top_le_bot {α : Type*} [bounded_lattice α] (h : (⊤ : α) ≤ (⊥ : α)) :
  subsingleton α :=
⟨λ a b, le_antisymm (le_trans le_top $ le_trans h bot_le) (le_trans le_top $ le_trans h bot_le)⟩

lemma subsingleton_of_bot_eq_top {α : Type*} [bounded_lattice α] (hα : (⊥ : α) = (⊤ : α)) :
  subsingleton α :=
subsingleton_of_top_le_bot (ge_of_eq hα)

lemma subsingleton_iff_bot_eq_top {α : Type*} [bounded_lattice α] :
  (⊥ : α) = (⊤ : α) ↔ subsingleton α :=
⟨subsingleton_of_bot_eq_top, λ h, by exactI subsingleton.elim ⊥ ⊤⟩

/-- Attach `⊥` to a type. -/
def with_bot (α : Type*) := option α

namespace with_bot

meta instance {α} [has_to_format α] : has_to_format (with_bot α) :=
{ to_format := λ x,
  match x with
  | none := "⊥"
  | (some x) := to_fmt x
  end }

instance : has_coe_t α (with_bot α) := ⟨some⟩
instance has_bot : has_bot (with_bot α) := ⟨none⟩

instance : inhabited (with_bot α) := ⟨⊥⟩

lemma none_eq_bot : (none : with_bot α) = (⊥ : with_bot α) := rfl
lemma some_eq_coe (a : α) : (some a : with_bot α) = (↑a : with_bot α) := rfl

/-- Recursor for `with_bot` using the preferred forms `⊥` and `↑a`. -/
@[elab_as_eliminator]
def rec_bot_coe {C : with_bot α → Sort*} (h₁ : C ⊥) (h₂ : Π (a : α), C a) :
  Π (n : with_bot α), C n :=
option.rec h₁ h₂

@[norm_cast]
theorem coe_eq_coe {a b : α} : (a : with_bot α) = b ↔ a = b :=
by rw [← option.some.inj_eq a b]; refl

@[priority 10]
instance has_lt [has_lt α] : has_lt (with_bot α) :=
{ lt := λ o₁ o₂ : option α, ∃ b ∈ o₂, ∀ a ∈ o₁, a < b }

@[simp] theorem some_lt_some [has_lt α] {a b : α} :
  @has_lt.lt (with_bot α) _ (some a) (some b) ↔ a < b :=
by simp [(<)]

lemma bot_lt_some [has_lt α] (a : α) : (⊥ : with_bot α) < some a :=
⟨a, rfl, λ b hb, (option.not_mem_none _ hb).elim⟩

lemma bot_lt_coe [has_lt α] (a : α) : (⊥ : with_bot α) < a := bot_lt_some a

instance [preorder α] : preorder (with_bot α) :=
{ le          := λ o₁ o₂ : option α, ∀ a ∈ o₁, ∃ b ∈ o₂, a ≤ b,
  lt          := (<),
  lt_iff_le_not_le := by intros; cases a; cases b;
                         simp [lt_iff_le_not_le]; simp [(<)];
                         split; refl,
  le_refl     := λ o a ha, ⟨a, ha, le_refl _⟩,
  le_trans    := λ o₁ o₂ o₃ h₁ h₂ a ha,
    let ⟨b, hb, ab⟩ := h₁ a ha, ⟨c, hc, bc⟩ := h₂ b hb in
    ⟨c, hc, le_trans ab bc⟩ }

instance partial_order [partial_order α] : partial_order (with_bot α) :=
{ le_antisymm := λ o₁ o₂ h₁ h₂, begin
    cases o₁ with a,
    { cases o₂ with b, {refl},
      rcases h₂ b rfl with ⟨_, ⟨⟩, _⟩ },
    { rcases h₁ a rfl with ⟨b, ⟨⟩, h₁'⟩,
      rcases h₂ b rfl with ⟨_, ⟨⟩, h₂'⟩,
      rw le_antisymm h₁' h₂' }
  end,
  .. with_bot.preorder }

instance order_bot [partial_order α] : order_bot (with_bot α) :=
{ bot_le := λ a a' h, option.no_confusion h,
  ..with_bot.partial_order, ..with_bot.has_bot }

@[simp, norm_cast] theorem coe_le_coe [preorder α] {a b : α} :
  (a : with_bot α) ≤ b ↔ a ≤ b :=
⟨λ h, by rcases h a rfl with ⟨_, ⟨⟩, h⟩; exact h,
 λ h a' e, option.some_inj.1 e ▸ ⟨b, rfl, h⟩⟩

@[simp] theorem some_le_some [preorder α] {a b : α} :
  @has_le.le (with_bot α) _ (some a) (some b) ↔ a ≤ b := coe_le_coe

theorem coe_le [partial_order α] {a b : α} :
  ∀ {o : option α}, b ∈ o → ((a : with_bot α) ≤ o ↔ a ≤ b)
| _ rfl := coe_le_coe

@[norm_cast]
lemma coe_lt_coe [partial_order α] {a b : α} : (a : with_bot α) < b ↔ a < b := some_lt_some

lemma le_coe_get_or_else [preorder α] : ∀ (a : with_bot α) (b : α), a ≤ a.get_or_else b
| (some a) b := le_refl a
| none     b := λ _ h, option.no_confusion h

@[simp] lemma get_or_else_bot (a : α) : option.get_or_else (⊥ : with_bot α) a = a := rfl

lemma get_or_else_bot_le_iff [order_bot α] {a : with_bot α} {b : α} :
  a.get_or_else ⊥ ≤ b ↔ a ≤ b :=
by cases a; simp [none_eq_bot, some_eq_coe]

instance decidable_le [preorder α] [@decidable_rel α (≤)] : @decidable_rel (with_bot α) (≤)
| none x := is_true $ λ a h, option.no_confusion h
| (some x) (some y) :=
  if h : x ≤ y
  then is_true (some_le_some.2 h)
  else is_false $ by simp *
| (some x) none := is_false $ λ h, by rcases h x rfl with ⟨y, ⟨_⟩, _⟩

instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_bot α) (<)
| none (some x) := is_true $ by existsi [x,rfl]; rintros _ ⟨⟩
| (some x) (some y) :=
  if h : x < y
  then is_true $ by simp *
  else is_false $ by simp *
| x none := is_false $ by rintro ⟨a,⟨⟨⟩⟩⟩

instance [partial_order α] [is_total α (≤)] : is_total (with_bot α) (≤) :=
{ total := λ a b, match a, b with
  | none  , _      := or.inl bot_le
  | _     , none   := or.inr bot_le
  | some x, some y := by simp only [some_le_some, total_of]
  end }

instance linear_order [linear_order α] : linear_order (with_bot α) :=
{ le_total := λ o₁ o₂, begin
    cases o₁ with a, {exact or.inl bot_le},
    cases o₂ with b, {exact or.inr bot_le},
    simp [le_total]
  end,
  decidable_le := with_bot.decidable_le,
  decidable_lt := with_bot.decidable_lt,
  ..with_bot.partial_order }

instance semilattice_sup [semilattice_sup α] : semilattice_sup_bot (with_bot α) :=
{ sup          := option.lift_or_get (⊔),
  le_sup_left  := λ o₁ o₂ a ha,
    by cases ha; cases o₂; simp [option.lift_or_get],
  le_sup_right := λ o₁ o₂ a ha,
    by cases ha; cases o₁; simp [option.lift_or_get],
  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
    cases o₁ with b; cases o₂ with c; cases ha,
    { exact h₂ a rfl },
    { exact h₁ a rfl },
    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
      simp at h₂,
      exact ⟨d, rfl, sup_le h₁' h₂⟩ }
  end,
  ..with_bot.order_bot }

lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_bot α) = a ⊔ b := rfl

instance semilattice_inf [semilattice_inf α] : semilattice_inf_bot (with_bot α) :=
{ inf          := λ o₁ o₂, o₁.bind (λ a, o₂.map (λ b, a ⊓ b)),
  inf_le_left  := λ o₁ o₂ a ha, begin
    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
    exact ⟨_, rfl, inf_le_left⟩
  end,
  inf_le_right := λ o₁ o₂ a ha, begin
    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
    exact ⟨_, rfl, inf_le_right⟩
  end,
  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
    cases ha,
    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
    exact ⟨_, rfl, le_inf ab ac⟩
  end,
  ..with_bot.order_bot }

lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_bot α) = a ⊓ b := rfl

instance lattice [lattice α] : lattice (with_bot α) :=
{ ..with_bot.semilattice_sup, ..with_bot.semilattice_inf }

theorem lattice_eq_DLO [linear_order α] :
  lattice_of_linear_order = @with_bot.lattice α _ :=
lattice.ext $ λ x y, iff.rfl

theorem sup_eq_max [linear_order α] (x y : with_bot α) : x ⊔ y = max x y :=
by rw [← sup_eq_max, lattice_eq_DLO]

theorem inf_eq_min [linear_order α] (x y : with_bot α) : x ⊓ y = min x y :=
by rw [← inf_eq_min, lattice_eq_DLO]

@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
lemma coe_min [linear_order α] (x y : α) : ((min x y : α) : with_bot α) = min x y :=
by simp [min, ite_cast]

@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
lemma coe_max [linear_order α] (x y : α) : ((max x y : α) : with_bot α) = max x y :=
by simp [max, ite_cast]

instance order_top [order_top α] : order_top (with_bot α) :=
{ top := some ⊤,
  le_top := λ o a ha, by cases ha; exact ⟨_, rfl, le_top⟩,
  ..with_bot.partial_order }

instance bounded_lattice [bounded_lattice α] : bounded_lattice (with_bot α) :=
{ ..with_bot.lattice, ..with_bot.order_top, ..with_bot.order_bot }

lemma well_founded_lt [partial_order α] (h : well_founded ((<) : α → α → Prop)) :
  well_founded ((<) : with_bot α → with_bot α → Prop) :=
have acc_bot : acc ((<) : with_bot α → with_bot α → Prop) ⊥ :=
  acc.intro _ (λ a ha, (not_le_of_gt ha bot_le).elim),
⟨λ a, option.rec_on a acc_bot (λ a, acc.intro _ (λ b, option.rec_on b (λ _, acc_bot)
(λ b, well_founded.induction h b
  (show ∀ b : α, (∀ c, c < b → (c : with_bot α) < a →
      acc ((<) : with_bot α → with_bot α → Prop) c) → (b : with_bot α) < a →
        acc ((<) : with_bot α → with_bot α → Prop) b,
  from λ b ih hba, acc.intro _ (λ c, option.rec_on c (λ _, acc_bot)
    (λ c hc, ih _ (some_lt_some.1 hc) (lt_trans hc hba)))))))⟩

instance densely_ordered [partial_order α] [densely_ordered α] [no_bot_order α] :
  densely_ordered (with_bot α) :=
⟨ assume a b,
  match a, b with
  | a,      none   := assume h : a < ⊥, (not_lt_bot h).elim
  | none,   some b := assume h, let ⟨a, ha⟩ := no_bot b in ⟨a, bot_lt_coe a, coe_lt_coe.2 ha⟩
  | some a, some b := assume h, let ⟨a, ha₁, ha₂⟩ := exists_between (coe_lt_coe.1 h) in
    ⟨a, coe_lt_coe.2 ha₁, coe_lt_coe.2 ha₂⟩
  end⟩

end with_bot

--TODO(Mario): Construct using order dual on with_bot
/-- Attach `⊤` to a type. -/
def with_top (α : Type*) := option α

namespace with_top

meta instance {α} [has_to_format α] : has_to_format (with_top α) :=
{ to_format := λ x,
  match x with
  | none := "⊤"
  | (some x) := to_fmt x
  end }

instance : has_coe_t α (with_top α) := ⟨some⟩
instance has_top : has_top (with_top α) := ⟨none⟩

instance : inhabited (with_top α) := ⟨⊤⟩

lemma none_eq_top : (none : with_top α) = (⊤ : with_top α) := rfl
lemma some_eq_coe (a : α) : (some a : with_top α) = (↑a : with_top α) := rfl

/-- Recursor for `with_top` using the preferred forms `⊤` and `↑a`. -/
@[elab_as_eliminator]
def rec_top_coe {C : with_top α → Sort*} (h₁ : C ⊤) (h₂ : Π (a : α), C a) :
  Π (n : with_top α), C n :=
option.rec h₁ h₂

@[norm_cast]
theorem coe_eq_coe {a b : α} : (a : with_top α) = b ↔ a = b :=
by rw [← option.some.inj_eq a b]; refl

@[simp] theorem top_ne_coe {a : α} : ⊤ ≠ (a : with_top α) .
@[simp] theorem coe_ne_top {a : α} : (a : with_top α) ≠ ⊤ .

@[priority 10]
instance has_lt [has_lt α] : has_lt (with_top α) :=
{ lt := λ o₁ o₂ : option α, ∃ b ∈ o₁, ∀ a ∈ o₂, b < a }

@[priority 10]
instance has_le [has_le α] : has_le (with_top α) :=
{ le          := λ o₁ o₂ : option α, ∀ a ∈ o₂, ∃ b ∈ o₁, b ≤ a }

@[simp] theorem some_lt_some [has_lt α] {a b : α} :
  @has_lt.lt (with_top α) _ (some a) (some b) ↔ a < b :=
by simp [(<)]

@[simp] theorem some_le_some [has_le α] {a b : α} :
  @has_le.le (with_top α) _ (some a) (some b) ↔ a ≤ b :=
by simp [(≤)]

@[simp] theorem le_none [has_le α] {a : with_top α} :
  @has_le.le (with_top α) _ a none :=
by simp [(≤)]

@[simp] theorem some_lt_none [has_lt α] {a : α} :
  @has_lt.lt (with_top α) _ (some a) none :=
by simp [(<)]; existsi a; refl

instance : can_lift (with_top α) α :=
{ coe := coe,
  cond := λ r, r ≠ ⊤,
  prf := λ x hx, ⟨option.get $ option.ne_none_iff_is_some.1 hx, option.some_get _⟩ }

instance [preorder α] : preorder (with_top α) :=
{ le          := λ o₁ o₂ : option α, ∀ a ∈ o₂, ∃ b ∈ o₁, b ≤ a,
  lt          := (<),
  lt_iff_le_not_le := by { intros; cases a; cases b;
                           simp [lt_iff_le_not_le]; simp [(<),(≤)] },
  le_refl     := λ o a ha, ⟨a, ha, le_refl _⟩,
  le_trans    := λ o₁ o₂ o₃ h₁ h₂ c hc,
    let ⟨b, hb, bc⟩ := h₂ c hc, ⟨a, ha, ab⟩ := h₁ b hb in
    ⟨a, ha, le_trans ab bc⟩,
 }

instance partial_order [partial_order α] : partial_order (with_top α) :=
{ le_antisymm := λ o₁ o₂ h₁ h₂, begin
    cases o₂ with b,
    { cases o₁ with a, {refl},
      rcases h₂ a rfl with ⟨_, ⟨⟩, _⟩ },
    { rcases h₁ b rfl with ⟨a, ⟨⟩, h₁'⟩,
      rcases h₂ a rfl with ⟨_, ⟨⟩, h₂'⟩,
      rw le_antisymm h₁' h₂' }
  end,
  .. with_top.preorder }

instance order_top [partial_order α] : order_top (with_top α) :=
{ le_top := λ a a' h, option.no_confusion h,
  ..with_top.partial_order, .. with_top.has_top }

@[simp, norm_cast] theorem coe_le_coe [partial_order α] {a b : α} :
  (a : with_top α) ≤ b ↔ a ≤ b :=
⟨λ h, by rcases h b rfl with ⟨_, ⟨⟩, h⟩; exact h,
 λ h a' e, option.some_inj.1 e ▸ ⟨a, rfl, h⟩⟩

theorem le_coe [partial_order α] {a b : α} :
  ∀ {o : option α}, a ∈ o →
  (@has_le.le (with_top α) _ o b ↔ a ≤ b)
| _ rfl := coe_le_coe

theorem le_coe_iff [partial_order α] {b : α} : ∀{x : with_top α}, x ≤ b ↔ (∃a:α, x = a ∧ a ≤ b)
| (some a) := by simp [some_eq_coe, coe_eq_coe]
| none     := by simp [none_eq_top]

theorem coe_le_iff [partial_order α] {a : α} : ∀{x : with_top α}, ↑a ≤ x ↔ (∀b:α, x = ↑b → a ≤ b)
| (some b) := by simp [some_eq_coe, coe_eq_coe]
| none     := by simp [none_eq_top]

theorem lt_iff_exists_coe [partial_order α] : ∀{a b : with_top α}, a < b ↔ (∃p:α, a = p ∧ ↑p < b)
| (some a) b := by simp [some_eq_coe, coe_eq_coe]
| none     b := by simp [none_eq_top]

@[norm_cast]
lemma coe_lt_coe [partial_order α] {a b : α} : (a : with_top α) < b ↔ a < b := some_lt_some

lemma coe_lt_top [partial_order α] (a : α) : (a : with_top α) < ⊤ := some_lt_none

theorem coe_lt_iff [partial_order α] {a : α} : ∀{x : with_top α}, ↑a < x ↔ (∀b:α, x = ↑b → a < b)
| (some b) := by simp [some_eq_coe, coe_eq_coe, coe_lt_coe]
| none     := by simp [none_eq_top, coe_lt_top]

lemma not_top_le_coe [partial_order α] (a : α) : ¬ (⊤:with_top α) ≤ ↑a :=
assume h, (lt_irrefl ⊤ (lt_of_le_of_lt h (coe_lt_top a))).elim

instance decidable_le [preorder α] [@decidable_rel α (≤)] : @decidable_rel (with_top α) (≤) :=
λ x y, @with_bot.decidable_le (order_dual α) _ _ y x

instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_top α) (<) :=
λ x y, @with_bot.decidable_lt (order_dual α) _ _ y x

instance [partial_order α] [is_total α (≤)] : is_total (with_top α) (≤) :=
{ total := λ a b, match a, b with
  | none  , _      := or.inr le_top
  | _     , none   := or.inl le_top
  | some x, some y := by simp only [some_le_some, total_of]
  end }

instance linear_order [linear_order α] : linear_order (with_top α) :=
{ le_total := λ o₁ o₂, begin
    cases o₁ with a, {exact or.inr le_top},
    cases o₂ with b, {exact or.inl le_top},
    simp [le_total]
  end,
  decidable_le := with_top.decidable_le,
  decidable_lt := with_top.decidable_lt,
  ..with_top.partial_order }

instance semilattice_inf [semilattice_inf α] : semilattice_inf_top (with_top α) :=
{ inf          := option.lift_or_get (⊓),
  inf_le_left  := λ o₁ o₂ a ha,
    by cases ha; cases o₂; simp [option.lift_or_get],
  inf_le_right := λ o₁ o₂ a ha,
    by cases ha; cases o₁; simp [option.lift_or_get],
  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
    cases o₂ with b; cases o₃ with c; cases ha,
    { exact h₂ a rfl },
    { exact h₁ a rfl },
    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
      simp at h₂,
      exact ⟨d, rfl, le_inf h₁' h₂⟩ }
  end,
  ..with_top.order_top }

lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_top α) = a ⊓ b := rfl

instance semilattice_sup [semilattice_sup α] : semilattice_sup_top (with_top α) :=
{ sup          := λ o₁ o₂, o₁.bind (λ a, o₂.map (λ b, a ⊔ b)),
  le_sup_left  := λ o₁ o₂ a ha, begin
    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
    exact ⟨_, rfl, le_sup_left⟩
  end,
  le_sup_right := λ o₁ o₂ a ha, begin
    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
    exact ⟨_, rfl, le_sup_right⟩
  end,
  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
    cases ha,
    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
    exact ⟨_, rfl, sup_le ab ac⟩
  end,
  ..with_top.order_top }

lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_top α) = a ⊔ b := rfl

instance lattice [lattice α] : lattice (with_top α) :=
{ ..with_top.semilattice_sup, ..with_top.semilattice_inf }

theorem lattice_eq_DLO [linear_order α] :
  lattice_of_linear_order = @with_top.lattice α _ :=
lattice.ext $ λ x y, iff.rfl

theorem sup_eq_max [linear_order α] (x y : with_top α) : x ⊔ y = max x y :=
by rw [← sup_eq_max, lattice_eq_DLO]

theorem inf_eq_min [linear_order α] (x y : with_top α) : x ⊓ y = min x y :=
by rw [← inf_eq_min, lattice_eq_DLO]

@[simp, norm_cast]
lemma coe_min [linear_order α] (x y : α) : ((min x y : α) : with_top α) = min x y :=
by simp [min, ite_cast]

@[simp, norm_cast]
lemma coe_max [linear_order α] (x y : α) : ((max x y : α) : with_top α) = max x y :=
by simp [max, ite_cast]

instance order_bot [order_bot α] : order_bot (with_top α) :=
{ bot := some ⊥,
  bot_le := λ o a ha, by cases ha; exact ⟨_, rfl, bot_le⟩,
  ..with_top.partial_order }

instance bounded_lattice [bounded_lattice α] : bounded_lattice (with_top α) :=
{ ..with_top.lattice, ..with_top.order_top, ..with_top.order_bot }

lemma well_founded_lt {α : Type*} [partial_order α] (h : well_founded ((<) : α → α → Prop)) :
  well_founded ((<) : with_top α → with_top α → Prop) :=
have acc_some : ∀ a : α, acc ((<) : with_top α → with_top α → Prop) (some a) :=
λ a, acc.intro _ (well_founded.induction h a
  (show ∀ b, (∀ c, c < b → ∀ d : with_top α, d < some c → acc (<) d) →
    ∀ y : with_top α, y < some b → acc (<) y,
  from λ b ih c, option.rec_on c (λ hc, (not_lt_of_ge le_top hc).elim)
    (λ c hc, acc.intro _ (ih _ (some_lt_some.1 hc))))),
⟨λ a, option.rec_on a (acc.intro _ (λ y, option.rec_on y (λ h, (lt_irrefl _ h).elim)
  (λ _ _, acc_some _))) acc_some⟩

instance densely_ordered [partial_order α] [densely_ordered α] [no_top_order α] :
  densely_ordered (with_top α) :=
⟨ assume a b,
  match a, b with
  | none,   a   := assume h : ⊤ < a, (not_top_lt h).elim
  | some a, none := assume h, let ⟨b, hb⟩ := no_top a in ⟨b, coe_lt_coe.2 hb, coe_lt_top b⟩
  | some a, some b := assume h, let ⟨a, ha₁, ha₂⟩ := exists_between (coe_lt_coe.1 h) in
    ⟨a, coe_lt_coe.2 ha₁, coe_lt_coe.2 ha₂⟩
  end⟩

lemma lt_iff_exists_coe_btwn [partial_order α] [densely_ordered α] [no_top_order α]
  {a b : with_top α} :
  (a < b) ↔ (∃ x : α, a < ↑x ∧ ↑x < b) :=
⟨λ h, let ⟨y, hy⟩ := exists_between h, ⟨x, hx⟩ := lt_iff_exists_coe.1 hy.2 in ⟨x, hx.1 ▸ hy⟩,
 λ ⟨x, hx⟩, lt_trans hx.1 hx.2⟩

end with_top

namespace subtype

/-- A subtype forms a `⊔`-`⊥`-semilattice if `⊥` and `⊔` preserve the property. -/
protected def semilattice_sup_bot [semilattice_sup_bot α] {P : α → Prop}
  (Pbot : P ⊥) (Psup : ∀⦃x y⦄, P x → P y → P (x ⊔ y)) : semilattice_sup_bot {x : α // P x} :=
{ bot := ⟨⊥, Pbot⟩,
  bot_le := λ x, @bot_le α _ x,
  ..subtype.semilattice_sup Psup }

/-- A subtype forms a `⊓`-`⊥`-semilattice if `⊥` and `⊓` preserve the property. -/
protected def semilattice_inf_bot [semilattice_inf_bot α] {P : α → Prop}
  (Pbot : P ⊥) (Pinf : ∀⦃x y⦄, P x → P y → P (x ⊓ y)) : semilattice_inf_bot {x : α // P x} :=
{ bot := ⟨⊥, Pbot⟩,
  bot_le := λ x, @bot_le α _ x,
  ..subtype.semilattice_inf Pinf }

/-- A subtype forms a `⊓`-`⊤`-semilattice if `⊤` and `⊓` preserve the property. -/
protected def semilattice_inf_top [semilattice_inf_top α] {P : α → Prop}
  (Ptop : P ⊤) (Pinf : ∀{{x y}}, P x → P y → P (x ⊓ y)) : semilattice_inf_top {x : α // P x} :=
{ top := ⟨⊤, Ptop⟩,
  le_top := λ x, @le_top α _ x,
  ..subtype.semilattice_inf Pinf }

end subtype

namespace order_dual
variable (α)

instance [has_bot α] : has_top (order_dual α) := ⟨(⊥ : α)⟩
instance [has_top α] : has_bot (order_dual α) := ⟨(⊤ : α)⟩

instance [order_bot α] : order_top (order_dual α) :=
{ le_top := @bot_le α _,
  .. order_dual.partial_order α, .. order_dual.has_top α }

instance [order_top α] : order_bot (order_dual α) :=
{ bot_le := @le_top α _,
  .. order_dual.partial_order α, .. order_dual.has_bot α }

instance [semilattice_inf_bot α] : semilattice_sup_top (order_dual α) :=
{ .. order_dual.semilattice_sup α, .. order_dual.order_top α }

instance [semilattice_inf_top α] : semilattice_sup_bot (order_dual α) :=
{ .. order_dual.semilattice_sup α, .. order_dual.order_bot α }

instance [semilattice_sup_bot α] : semilattice_inf_top (order_dual α) :=
{ .. order_dual.semilattice_inf α, .. order_dual.order_top α }

instance [semilattice_sup_top α] : semilattice_inf_bot (order_dual α) :=
{ .. order_dual.semilattice_inf α, .. order_dual.order_bot α }

instance [bounded_lattice α] : bounded_lattice (order_dual α) :=
{ .. order_dual.lattice α, .. order_dual.order_top α, .. order_dual.order_bot α }

instance [bounded_distrib_lattice α] : bounded_distrib_lattice (order_dual α) :=
{ .. order_dual.bounded_lattice α, .. order_dual.distrib_lattice α }

end order_dual

namespace prod
variables (α β)

instance [has_top α] [has_top β] : has_top (α × β) := ⟨⟨⊤, ⊤⟩⟩
instance [has_bot α] [has_bot β] : has_bot (α × β) := ⟨⟨⊥, ⊥⟩⟩

instance [order_top α] [order_top β] : order_top (α × β) :=
{ le_top := assume a, ⟨le_top, le_top⟩,
  .. prod.partial_order α β, .. prod.has_top α β }

instance [order_bot α] [order_bot β] : order_bot (α × β) :=
{ bot_le := assume a, ⟨bot_le, bot_le⟩,
  .. prod.partial_order α β, .. prod.has_bot α β }

instance [semilattice_sup_top α] [semilattice_sup_top β] : semilattice_sup_top (α × β) :=
{ .. prod.semilattice_sup α β, .. prod.order_top α β }

instance [semilattice_inf_top α] [semilattice_inf_top β] : semilattice_inf_top (α × β) :=
{ .. prod.semilattice_inf α β, .. prod.order_top α β }

instance [semilattice_sup_bot α] [semilattice_sup_bot β] : semilattice_sup_bot (α × β) :=
{ .. prod.semilattice_sup α β, .. prod.order_bot α β }

instance [semilattice_inf_bot α] [semilattice_inf_bot β] : semilattice_inf_bot (α × β) :=
{ .. prod.semilattice_inf α β, .. prod.order_bot α β }

instance [bounded_lattice α] [bounded_lattice β] : bounded_lattice (α × β) :=
{ .. prod.lattice α β, .. prod.order_top α β, .. prod.order_bot α β }

instance [bounded_distrib_lattice α] [bounded_distrib_lattice β] :
  bounded_distrib_lattice (α × β) :=
{ .. prod.bounded_lattice α β, .. prod.distrib_lattice α β }

end prod

section disjoint

section semilattice_inf_bot

variable [semilattice_inf_bot α]

/-- Two elements of a lattice are disjoint if their inf is the bottom element.
  (This generalizes disjoint sets, viewed as members of the subset lattice.) -/
def disjoint (a b : α) : Prop := a ⊓ b ≤ ⊥

theorem disjoint.eq_bot {a b : α} (h : disjoint a b) : a ⊓ b = ⊥ :=
eq_bot_iff.2 h

theorem disjoint_iff {a b : α} : disjoint a b ↔ a ⊓ b = ⊥ :=
eq_bot_iff.symm

theorem disjoint.comm {a b : α} : disjoint a b ↔ disjoint b a :=
by rw [disjoint, disjoint, inf_comm]

@[symm] theorem disjoint.symm ⦃a b : α⦄ : disjoint a b → disjoint b a :=
disjoint.comm.1

@[simp] theorem disjoint_bot_left {a : α} : disjoint ⊥ a := inf_le_left
@[simp] theorem disjoint_bot_right {a : α} : disjoint a ⊥ := inf_le_right

theorem disjoint.mono {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) :
  disjoint b d → disjoint a c := le_trans (inf_le_inf h₁ h₂)

theorem disjoint.mono_left {a b c : α} (h : a ≤ b) : disjoint b c → disjoint a c :=
disjoint.mono h (le_refl _)

theorem disjoint.mono_right {a b c : α} (h : b ≤ c) : disjoint a c → disjoint a b :=
disjoint.mono (le_refl _) h

@[simp] lemma disjoint_self {a : α} : disjoint a a ↔ a = ⊥ :=
by simp [disjoint]

lemma disjoint.ne {a b : α} (ha : a ≠ ⊥) (hab : disjoint a b) : a ≠ b :=
by { intro h, rw [←h, disjoint_self] at hab, exact ha hab }

end semilattice_inf_bot

section bounded_lattice

variables [bounded_lattice α] {a : α}

@[simp] theorem disjoint_top : disjoint a ⊤ ↔ a = ⊥ := by simp [disjoint_iff]
@[simp] theorem top_disjoint : disjoint ⊤ a ↔ a = ⊥ := by simp [disjoint_iff]

end bounded_lattice

section bounded_distrib_lattice

variables [bounded_distrib_lattice α] {a b c : α}

@[simp] lemma disjoint_sup_left : disjoint (a ⊔ b) c ↔ disjoint a c ∧ disjoint b c :=
by simp only [disjoint_iff, inf_sup_right, sup_eq_bot_iff]

@[simp] lemma disjoint_sup_right : disjoint a (b ⊔ c) ↔ disjoint a b ∧ disjoint a c :=
by simp only [disjoint_iff, inf_sup_left, sup_eq_bot_iff]

lemma disjoint.sup_left (ha : disjoint a c) (hb : disjoint b c) : disjoint (a ⊔ b) c :=
disjoint_sup_left.2 ⟨ha, hb⟩

lemma disjoint.sup_right (hb : disjoint a b) (hc : disjoint a c) : disjoint a (b ⊔ c) :=
disjoint_sup_right.2 ⟨hb, hc⟩

lemma disjoint.left_le_of_le_sup_right {a b c : α} (h : a ≤ b ⊔ c) (hd : disjoint a c) : a ≤ b :=
(λ x, le_of_inf_le_sup_le x (sup_le h le_sup_right)) ((disjoint_iff.mp hd).symm ▸ bot_le)

lemma disjoint.left_le_of_le_sup_left {a b c : α} (h : a ≤ c ⊔ b) (hd : disjoint a c) : a ≤ b :=
@le_of_inf_le_sup_le _ _ a b c ((disjoint_iff.mp hd).symm ▸ bot_le)
  ((@sup_comm _ _ c b) ▸ (sup_le h le_sup_left))

end bounded_distrib_lattice

end disjoint

section is_compl

/-!
### `is_compl` predicate
-/

/-- Two elements `x` and `y` are complements of each other if
`x ⊔ y = ⊤` and `x ⊓ y = ⊥`. -/
structure is_compl [bounded_lattice α] (x y : α) : Prop :=
(inf_le_bot : x ⊓ y ≤ ⊥)
(top_le_sup : ⊤ ≤ x ⊔ y)

namespace is_compl

section bounded_lattice

variables [bounded_lattice α] {x y z : α}

protected lemma disjoint (h : is_compl x y) : disjoint x y := h.1

@[symm] protected lemma symm (h : is_compl x y) : is_compl y x :=
⟨by { rw inf_comm, exact h.1 }, by { rw sup_comm, exact h.2 }⟩

lemma of_eq (h₁ : x ⊓ y = ⊥) (h₂ : x ⊔ y = ⊤) : is_compl x y :=
⟨le_of_eq h₁, le_of_eq h₂.symm⟩

lemma inf_eq_bot (h : is_compl x y) : x ⊓ y = ⊥ := h.disjoint.eq_bot

lemma sup_eq_top (h : is_compl x y) : x ⊔ y = ⊤ := top_unique h.top_le_sup

lemma to_order_dual (h : is_compl x y) : @is_compl (order_dual α) _ x y := ⟨h.2, h.1⟩

end bounded_lattice

variables [bounded_distrib_lattice α] {x y z : α}

lemma inf_left_eq_bot_iff (h : is_compl y z) : x ⊓ y = ⊥ ↔ x ≤ z :=
inf_eq_bot_iff_le_compl h.sup_eq_top h.inf_eq_bot

lemma inf_right_eq_bot_iff (h : is_compl y z) : x ⊓ z = ⊥ ↔ x ≤ y :=
h.symm.inf_left_eq_bot_iff

lemma disjoint_left_iff (h : is_compl y z) : disjoint x y ↔ x ≤ z :=
by { rw [disjoint_iff], exact h.inf_left_eq_bot_iff }

lemma disjoint_right_iff (h : is_compl y z) : disjoint x z ↔ x ≤ y :=
h.symm.disjoint_left_iff

lemma le_left_iff (h : is_compl x y) : z ≤ x ↔ disjoint z y :=
h.disjoint_right_iff.symm

lemma le_right_iff (h : is_compl x y) : z ≤ y ↔ disjoint z x :=
h.symm.le_left_iff

lemma left_le_iff (h : is_compl x y) : x ≤ z ↔ ⊤ ≤ z ⊔ y :=
h.to_order_dual.le_left_iff

lemma right_le_iff (h : is_compl x y) : y ≤ z ↔ ⊤ ≤ z ⊔ x :=
h.symm.left_le_iff

lemma antimono {x' y'} (h : is_compl x y) (h' : is_compl x' y') (hx : x ≤ x') :
  y' ≤ y :=
h'.right_le_iff.2 $ le_trans h.symm.top_le_sup (sup_le_sup_left hx _)

lemma right_unique (hxy : is_compl x y) (hxz : is_compl x z) :
  y = z :=
le_antisymm (hxz.antimono hxy $ le_refl x) (hxy.antimono hxz $ le_refl x)

lemma left_unique (hxz : is_compl x z) (hyz : is_compl y z) :
  x = y :=
hxz.symm.right_unique hyz.symm

lemma sup_inf {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
  is_compl (x ⊔ x') (y ⊓ y') :=
of_eq
  (by rw [inf_sup_right, ← inf_assoc, h.inf_eq_bot, bot_inf_eq, bot_sup_eq, inf_left_comm,
    h'.inf_eq_bot, inf_bot_eq])
  (by rw [sup_inf_left, @sup_comm _ _ x, sup_assoc, h.sup_eq_top, sup_top_eq, top_inf_eq,
    sup_assoc, sup_left_comm, h'.sup_eq_top, sup_top_eq])

lemma inf_sup {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
  is_compl (x ⊓ x') (y ⊔ y') :=
(h.symm.sup_inf h'.symm).symm

end is_compl

lemma is_compl_bot_top [bounded_lattice α] : is_compl (⊥ : α) ⊤ :=
is_compl.of_eq bot_inf_eq sup_top_eq

lemma is_compl_top_bot [bounded_lattice α] : is_compl (⊤ : α) ⊥ :=
is_compl.of_eq inf_bot_eq top_sup_eq

section
variables [bounded_lattice α] {x : α}

lemma eq_top_of_is_compl_bot (h : is_compl x ⊥) : x = ⊤ :=
sup_bot_eq.symm.trans h.sup_eq_top

lemma eq_top_of_bot_is_compl (h : is_compl ⊥ x) : x = ⊤ :=
eq_top_of_is_compl_bot h.symm

lemma eq_bot_of_is_compl_top (h : is_compl x ⊤) : x = ⊥ :=
eq_top_of_is_compl_bot h.to_order_dual

lemma eq_bot_of_top_is_compl (h : is_compl ⊤ x) : x = ⊥ :=
eq_top_of_bot_is_compl h.to_order_dual

end

/-- A complemented bounded lattice is one where every element has a
  (not necessarily unique) complement. -/
class is_complemented (α) [bounded_lattice α] : Prop :=
(exists_is_compl : ∀ (a : α), ∃ (b : α), is_compl a b)

export is_complemented (exists_is_compl)

namespace is_complemented
variables [bounded_lattice α] [is_complemented α]

instance : is_complemented (order_dual α) :=
⟨λ a, ⟨classical.some (@exists_is_compl α _ _ a),
  (classical.some_spec (@exists_is_compl α _ _ a)).to_order_dual⟩⟩

end is_complemented

end is_compl

section nontrivial

variables [bounded_lattice α] [nontrivial α]

lemma bot_ne_top : (⊥ : α) ≠ ⊤ :=
λ H, not_nontrivial_iff_subsingleton.mpr (subsingleton_of_bot_eq_top H) ‹_›

lemma top_ne_bot : (⊤ : α) ≠ ⊥ := ne.symm bot_ne_top

end nontrivial

namespace bool

instance : bounded_lattice bool :=
{ top := tt,
  le_top := λ x, le_tt,
  bot := ff,
  bot_le := λ x, ff_le,
  .. (infer_instance : lattice bool)}

end bool

section bool

@[simp] lemma top_eq_tt : ⊤ = tt := rfl

@[simp] lemma bot_eq_ff : ⊥ = ff := rfl

end bool


import data.nat.basic
import data.int.basic
import data.real.basic
open classical

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

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
iff.intro
  (assume h : ∀ x, p x ∧ q x,
    and.intro
      (λ x, show p x, from (h x).left)
      (λ x, show q x, from (h x).right))
  (assume h : (∀ x, p x) ∧ (∀ x, q x),
    λ x, show p x ∧ q x, from ⟨h.left x, h.right x⟩)

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
assume h1 : ∀ x, p x → q x,
assume h2 : ∀ x, p x,
λ x, show q x, from (h1 x) (h2 x)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
assume h : (∀ x, p x) ∨ (∀ x, q x),
λ x, show p x ∨ q x, from or.elim h
  (assume h1 : ∀ x, p x, or.inl (h1 x))
  (assume h2 : ∀ x, q x, or.inr (h2 x))

example : α → ((∀ x : α, r) ↔ r) :=
λ x, iff.intro
  (assume h : ∀ y : α, r, show r, from h x)
  (assume r1 : r, λ y, show r, from r1)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
iff.intro
  (assume h : ∀ x, p x ∨ r,
    by_cases
      (assume h1 : r, or.inr h1)
      (assume h1 : ¬r, or.inl
        (λ x, show p x, from or.elim (h x)
          (assume h2 : p x, h2)
          (assume h2 : r, false.elim (h1 h2)))))
  (assume h : (∀ x, p x) ∨ r,
    assume x : α,
    show p x ∨ r, from or.elim h
      (assume h1 : ∀ x, p x, or.inl (h1 x))
      (λ r1, or.inr r1))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
iff.intro
  (assume h : ∀ x, r → p x,
    λ r x, show p x, from h x r)
  (assume h : r → ∀ x, p x,
    λ x r, show p x, from h r x)

-- Barber paradox
variables (men : Type) (barber : men) (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
or.elim (classical.em (shaves barber barber))
  (assume h1 : shaves barber barber, (h barber).mp h1 h1)
  (assume h1 : ¬ shaves barber barber, h1 ((h barber).mpr h1))

-- Some number theory
def prime (n : ℕ) : Prop := ∀ (k : ℕ), k ∣ n → k = 1 ∨ k = n

def infinitely_many_primes : Prop := ∀ n, ∃ N, n < N ∧ prime N

def Fermat_prime (n : ℕ) : Prop := prime n ∧ ∃ (k : ℕ), n = 2 ^ k + 1

def infinitely_many_Fermat_primes : Prop := ∀ n, ∃ N, n < N ∧ Fermat_prime N

def goldbach_conjecture : Prop :=
  ∀ (n : ℕ), even n → (∃ x y, prime x ∧ prime y ∧ n = x + y)

def Goldbach's_weak_conjecture : Prop :=
  ∀ (n : ℕ), ¬ even n ∧ n > 5 → (∃ x y z, prime x ∧ prime y ∧ prime z ∧ n = x + y + z)

def Fermat's_last_theorem : Prop :=
  ∀ (n : ℕ), n > 2 → ¬(∃ (a b c : ℕ), a ^ n + b ^ n = c ^ n)

-- Very fun
example : (∃ x : α, r) → r :=
assume h : ∃ x, r,
let ⟨x, r⟩ := h in r

example (a : α) : r → (∃ x : α, r) :=
λ r0, exists.intro a r0

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
iff.intro
  (assume h : ∃ x, p x ∧ r,
    let ⟨x, hx⟩ := h in ⟨⟨x, hx.left⟩, hx.right⟩)
  (assume h : (∃ x, p x) ∧ r,
    let ⟨x, hx⟩ := h.left in ⟨x, hx, h.right⟩)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
  (assume h : ∃ x, p x ∨ q x,
    let ⟨x, hx⟩ := h in or.elim hx
      (assume h1 : p x, or.inl ⟨x, h1⟩)
      (assume h1 : q x, or.inr ⟨x, h1⟩))
  (assume h : (∃ x, p x) ∨ (∃ x, q x),
    or.elim h
      (assume h1 : ∃ x, p x, let ⟨x, hx⟩ := h1 in ⟨x, or.inl hx⟩)
      (assume h1 : ∃ x, q x, let ⟨x, hx⟩ := h1 in ⟨x, or.inr hx⟩))

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
iff.intro
  (assume h1 : ∀ x, p x,
    assume h2 : ∃ x, ¬ p x,
    let ⟨x, hnpx⟩ := h2 in hnpx (h1 x))
  (assume h1 : ¬ (∃ x, ¬ p x),
    λ x, by_cases
      (assume h2 : p x, h2)
      (assume h2 : ¬ p x, false.elim (h1 ⟨x, h2⟩)))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
iff.intro
  (assume h1 : ∃ x, p x,
    assume h2 : ∀ x, ¬ p x,
    let ⟨x, hpx⟩ := h1 in h2 x hpx)
  (assume h1 : ¬ (∀ x, ¬ p x),
    classical.by_contradiction
      (assume h2 : ¬ (∃ x, p x),
        suffices h3 : ∀ x, ¬ p x, from h1 h3,
        λ x, assume h4 : p x, h2 ⟨x, h4⟩))

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
iff.intro
  (assume h1 : ¬ ∃ x, p x,
    λ x, by_cases
      (assume h2 : p x, false.elim (h1 ⟨x, h2⟩))
      (assume h2 : ¬ p x, h2))
  (assume h1 : ∀ x, ¬ p x,
    assume h2 : ∃ x, p x,
    let ⟨x, hpx⟩ := h2 in h1 x hpx)

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
iff.intro
  (assume h1 : ¬ ∀ x, p x,
    classical.by_contradiction
      (assume h2 : ¬ (∃ x, ¬ p x),
        suffices h3 : ∀ x, p x, from h1 h3,
        λ x, by_cases
          (assume h4 : p x, h4)
          (assume h4 : ¬ p x, false.elim (h2 ⟨x, h4⟩))))
  (assume h1 : ∃ x, ¬ p x,
    assume h2 : ∀ x, p x,
    let ⟨x, hnpx⟩ := h1 in hnpx (h2 x))

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
iff.intro
  (assume h1 : ∀ x, p x → r,
    assume h2 : ∃ x, p x,
    let ⟨x, hpx⟩ := h2 in h1 x hpx)
  (assume h1 : (∃ x, p x) → r,
    λ x, assume h2 : p x, h1 ⟨x, h2⟩)

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
iff.intro
  (assume h1 : ∃ x, p x → r,
    assume h2 : ∀ x, p x,
    let ⟨x, hpxr⟩ := h1 in hpxr (h2 x))
  -- This solution is very cursed
  (assume h1 : (∀ x, p x) → r,
    show ∃ x, p x → r, from
      by_cases
        (assume hap : ∀ x, p x, ⟨a, λ h', h1 hap⟩)
        (assume hnap : ¬ ∀ x, p x,
          classical.by_contradiction
            (assume hnex : ¬ ∃ x, p x → r,
              have hap : ∀ x, p x, from
                assume x,
                classical.by_contradiction
                  (assume hnp : ¬ p x,
                    have hex : ∃ x, p x → r,
                      from ⟨x, (assume hp, absurd hp hnp)⟩,
                    show false, from hnex hex),
              show false, from hnap hap)))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
iff.intro
  (assume h1 : ∃ x, r → p x,
    assume r1 : r,
    let ⟨x, hrpx⟩ := h1 in ⟨x, hrpx r1⟩)
  (assume h1 : r → ∃ x, p x,
    by_cases
      (assume h2 : r,
        let ⟨x, hpx⟩ := h1 h2 in ⟨x, λ r, hpx⟩)
      (assume h2 : ¬ r,
        exists.intro a
          (assume r1 : r, false.elim (h2 r1))))

-- Some calculation
variables log exp : real → real
variable log_exp_eq : ∀ x, log (exp x) = x
variable exp_log_eq : ∀ x, x > 0 → exp (log x) = x
variable exp_pos : ∀ x, exp x > 0
variable exp_add : ∀ x y, exp (x + y) = exp x * exp y
include log_exp_eq exp_log_eq exp_pos exp_add

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
calc log (x * y) = log (x * exp (log y)) : by rw exp_log_eq y hy
... = log (exp (log x) * exp (log y)) : by rw exp_log_eq x hx
... = log (exp (log x + log y)) : by rw exp_add
... = log x + log y : log_exp_eq _

example (x : ℤ) : x * 0 = 0 :=
calc x * 0 = x * (x - x) : by rw ←sub_self
... = x * x - x * x : by rw mul_sub
... = 0 : by rw sub_self


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.set.intervals.unordered_interval
import linear_algebra.affine_space.affine_equiv

/-!
# Affine spaces

This file defines affine subspaces (over modules) and the affine span of a set of points.

## Main definitions

* `affine_subspace k P` is the type of affine subspaces.  Unlike
  affine spaces, affine subspaces are allowed to be empty, and lemmas
  that do not apply to empty affine subspaces have `nonempty`
  hypotheses.  There is a `complete_lattice` structure on affine
  subspaces.
* `affine_subspace.direction` gives the `submodule` spanned by the
  pairwise differences of points in an `affine_subspace`.  There are
  various lemmas relating to the set of vectors in the `direction`,
  and relating the lattice structure on affine subspaces to that on
  their directions.
* `affine_span` gives the affine subspace spanned by a set of points,
  with `vector_span` giving its direction.  `affine_span` is defined
  in terms of `span_points`, which gives an explicit description of
  the points contained in the affine span; `span_points` itself should
  generally only be used when that description is required, with
  `affine_span` being the main definition for other purposes.  Two
  other descriptions of the affine span are proved equivalent: it is
  the `Inf` of affine subspaces containing the points, and (if
  `[nontrivial k]`) it contains exactly those points that are affine
  combinations of points in the given set.

## Implementation notes

`out_param` is used in the definiton of `add_torsor V P` to make `V` an implicit argument (deduced
from `P`) in most cases; `include V` is needed in many cases for `V`, and type classes using it, to
be added as implicit arguments to individual lemmas.  As for modules, `k` is an explicit argument
rather than implied by `P` or `V`.

This file only provides purely algebraic definitions and results.
Those depending on analysis or topology are defined elsewhere; see
`analysis.normed_space.add_torsor` and `topology.algebra.affine`.

## References

* https://en.wikipedia.org/wiki/Affine_space
* https://en.wikipedia.org/wiki/Principal_homogeneous_space
-/

noncomputable theory
open_locale big_operators classical affine

open set

section

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [affine_space V P]
include V

/-- The submodule spanning the differences of a (possibly empty) set
of points. -/
def vector_span (s : set P) : submodule k V := submodule.span k (s -ᵥ s)

/-- The definition of `vector_span`, for rewriting. -/
lemma vector_span_def (s : set P) : vector_span k s = submodule.span k (s -ᵥ s) :=
rfl

/-- `vector_span` is monotone. -/
lemma vector_span_mono {s₁ s₂ : set P} (h : s₁ ⊆ s₂) : vector_span k s₁ ≤ vector_span k s₂ :=
submodule.span_mono (vsub_self_mono h)

variables (P)

/-- The `vector_span` of the empty set is `⊥`. -/
@[simp] lemma vector_span_empty : vector_span k (∅ : set P) = (⊥ : submodule k V) :=
by rw [vector_span_def, vsub_empty, submodule.span_empty]

variables {P}

/-- The `vector_span` of a single point is `⊥`. -/
@[simp] lemma vector_span_singleton (p : P) : vector_span k ({p} : set P) = ⊥ :=
by simp [vector_span_def]

/-- The `s -ᵥ s` lies within the `vector_span k s`. -/
lemma vsub_set_subset_vector_span (s : set P) : s -ᵥ s ⊆ ↑(vector_span k s) :=
submodule.subset_span

/-- Each pairwise difference is in the `vector_span`. -/
lemma vsub_mem_vector_span {s : set P} {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) :
  p1 -ᵥ p2 ∈ vector_span k s :=
vsub_set_subset_vector_span k s (vsub_mem_vsub hp1 hp2)

/-- The points in the affine span of a (possibly empty) set of
points. Use `affine_span` instead to get an `affine_subspace k P`. -/
def span_points (s : set P) : set P :=
{p | ∃ p1 ∈ s, ∃ v ∈ (vector_span k s), p = v +ᵥ p1}

/-- A point in a set is in its affine span. -/
lemma mem_span_points (p : P) (s : set P) : p ∈ s → p ∈ span_points k s
| hp := ⟨p, hp, 0, submodule.zero_mem _, (zero_vadd V p).symm⟩

/-- A set is contained in its `span_points`. -/
lemma subset_span_points (s : set P) : s ⊆ span_points k s :=
λ p, mem_span_points k p s

/-- The `span_points` of a set is nonempty if and only if that set
is. -/
@[simp] lemma span_points_nonempty (s : set P) :
  (span_points k s).nonempty ↔ s.nonempty :=
begin
  split,
  { contrapose,
    rw [set.not_nonempty_iff_eq_empty, set.not_nonempty_iff_eq_empty],
    intro h,
    simp [h, span_points] },
  { exact λ h, h.mono (subset_span_points _ _) }
end

/-- Adding a point in the affine span and a vector in the spanning
submodule produces a point in the affine span. -/
lemma vadd_mem_span_points_of_mem_span_points_of_mem_vector_span {s : set P} {p : P} {v : V}
    (hp : p ∈ span_points k s) (hv : v ∈ vector_span k s) : v +ᵥ p ∈ span_points k s :=
begin
  rcases hp with ⟨p2, ⟨hp2, ⟨v2, ⟨hv2, hv2p⟩⟩⟩⟩,
  rw [hv2p, vadd_vadd],
  use [p2, hp2, v + v2, (vector_span k s).add_mem hv hv2, rfl]
end

/-- Subtracting two points in the affine span produces a vector in the
spanning submodule. -/
lemma vsub_mem_vector_span_of_mem_span_points_of_mem_span_points {s : set P} {p1 p2 : P}
    (hp1 : p1 ∈ span_points k s) (hp2 : p2 ∈ span_points k s) :
  p1 -ᵥ p2 ∈ vector_span k s :=
begin
  rcases hp1 with ⟨p1a, ⟨hp1a, ⟨v1, ⟨hv1, hv1p⟩⟩⟩⟩,
  rcases hp2 with ⟨p2a, ⟨hp2a, ⟨v2, ⟨hv2, hv2p⟩⟩⟩⟩,
  rw [hv1p, hv2p, vsub_vadd_eq_vsub_sub (v1 +ᵥ p1a), vadd_vsub_assoc, add_comm, add_sub_assoc],
  have hv1v2 : v1 - v2 ∈ vector_span k s,
  { rw sub_eq_add_neg,
    apply (vector_span k s).add_mem hv1,
    rw ←neg_one_smul k v2,
    exact (vector_span k s).smul_mem (-1 : k) hv2 },
  refine (vector_span k s).add_mem _ hv1v2,
  exact vsub_mem_vector_span k hp1a hp2a
end

end

/-- An `affine_subspace k P` is a subset of an `affine_space V P`
that, if not empty, has an affine space structure induced by a
corresponding subspace of the `module k V`. -/
structure affine_subspace (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V]
    [module k V] [affine_space V P] :=
(carrier : set P)
(smul_vsub_vadd_mem : ∀ (c : k) {p1 p2 p3 : P}, p1 ∈ carrier → p2 ∈ carrier → p3 ∈ carrier →
  c • (p1 -ᵥ p2 : V) +ᵥ p3 ∈ carrier)

namespace submodule

variables {k V : Type*} [ring k] [add_comm_group V] [module k V]

/-- Reinterpret `p : submodule k V` as an `affine_subspace k V`. -/
def to_affine_subspace (p : submodule k V) : affine_subspace k V :=
{ carrier := p,
  smul_vsub_vadd_mem := λ c p₁ p₂ p₃ h₁ h₂ h₃, p.add_mem (p.smul_mem _ (p.sub_mem h₁ h₂)) h₃ }

end submodule

namespace affine_subspace

variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

-- TODO Refactor to use `instance : set_like (affine_subspace k P) P :=` instead
instance : has_coe (affine_subspace k P) (set P) := ⟨carrier⟩
instance : has_mem P (affine_subspace k P) := ⟨λ p s, p ∈ (s : set P)⟩

/-- A point is in an affine subspace coerced to a set if and only if
it is in that affine subspace. -/
@[simp] lemma mem_coe (p : P) (s : affine_subspace k P) :
  p ∈ (s : set P) ↔ p ∈ s :=
iff.rfl

variables {k P}

/-- The direction of an affine subspace is the submodule spanned by
the pairwise differences of points.  (Except in the case of an empty
affine subspace, where the direction is the zero submodule, every
vector in the direction is the difference of two points in the affine
subspace.) -/
def direction (s : affine_subspace k P) : submodule k V := vector_span k (s : set P)

/-- The direction equals the `vector_span`. -/
lemma direction_eq_vector_span (s : affine_subspace k P) :
  s.direction = vector_span k (s : set P) :=
rfl

/-- Alternative definition of the direction when the affine subspace
is nonempty.  This is defined so that the order on submodules (as used
in the definition of `submodule.span`) can be used in the proof of
`coe_direction_eq_vsub_set`, and is not intended to be used beyond
that proof. -/
def direction_of_nonempty {s : affine_subspace k P} (h : (s : set P).nonempty) :
  submodule k V :=
{ carrier := (s : set P) -ᵥ s,
  zero_mem' := begin
    cases h with p hp,
    exact (vsub_self p) ▸ vsub_mem_vsub hp hp
  end,
  add_mem' := begin
    intros a b ha hb,
    rcases ha with ⟨p1, p2, hp1, hp2, rfl⟩,
    rcases hb with ⟨p3, p4, hp3, hp4, rfl⟩,
    rw [←vadd_vsub_assoc],
    refine vsub_mem_vsub _ hp4,
    convert s.smul_vsub_vadd_mem 1 hp1 hp2 hp3,
    rw one_smul
  end,
  smul_mem' := begin
    intros c v hv,
    rcases hv with ⟨p1, p2, hp1, hp2, rfl⟩,
    rw [←vadd_vsub (c • (p1 -ᵥ p2)) p2],
    refine vsub_mem_vsub _ hp2,
    exact s.smul_vsub_vadd_mem c hp1 hp2 hp2
  end }

/-- `direction_of_nonempty` gives the same submodule as
`direction`. -/
lemma direction_of_nonempty_eq_direction {s : affine_subspace k P} (h : (s : set P).nonempty) :
  direction_of_nonempty h = s.direction :=
le_antisymm (vsub_set_subset_vector_span k s) (submodule.span_le.2 set.subset.rfl)

/-- The set of vectors in the direction of a nonempty affine subspace
is given by `vsub_set`. -/
lemma coe_direction_eq_vsub_set {s : affine_subspace k P} (h : (s : set P).nonempty) :
  (s.direction : set V) = (s : set P) -ᵥ s :=
direction_of_nonempty_eq_direction h ▸ rfl

/-- A vector is in the direction of a nonempty affine subspace if and
only if it is the subtraction of two vectors in the subspace. -/
lemma mem_direction_iff_eq_vsub {s : affine_subspace k P} (h : (s : set P).nonempty) (v : V) :
  v ∈ s.direction ↔ ∃ p1 ∈ s, ∃ p2 ∈ s, v = p1 -ᵥ p2 :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set h],
  exact ⟨λ ⟨p1, p2, hp1, hp2, hv⟩, ⟨p1, hp1, p2, hp2, hv.symm⟩,
         λ ⟨p1, hp1, p2, hp2, hv⟩, ⟨p1, p2, hp1, hp2, hv.symm⟩⟩
end

/-- Adding a vector in the direction to a point in the subspace
produces a point in the subspace. -/
lemma vadd_mem_of_mem_direction {s : affine_subspace k P} {v : V} (hv : v ∈ s.direction) {p : P}
    (hp : p ∈ s) : v +ᵥ p ∈ s :=
begin
  rw mem_direction_iff_eq_vsub ⟨p, hp⟩ at hv,
  rcases hv with ⟨p1, hp1, p2, hp2, hv⟩,
  rw hv,
  convert s.smul_vsub_vadd_mem 1 hp1 hp2 hp,
  rw one_smul
end

/-- Subtracting two points in the subspace produces a vector in the
direction. -/
lemma vsub_mem_direction {s : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) :
  (p1 -ᵥ p2) ∈ s.direction :=
vsub_mem_vector_span k hp1 hp2

/-- Adding a vector to a point in a subspace produces a point in the
subspace if and only if the vector is in the direction. -/
lemma vadd_mem_iff_mem_direction {s : affine_subspace k P} (v : V) {p : P} (hp : p ∈ s) :
  v +ᵥ p ∈ s ↔ v ∈ s.direction :=
⟨λ h, by simpa using vsub_mem_direction h hp, λ h, vadd_mem_of_mem_direction h hp⟩

/-- Given a point in an affine subspace, the set of vectors in its
direction equals the set of vectors subtracting that point on the
right. -/
lemma coe_direction_eq_vsub_set_right {s : affine_subspace k P} {p : P} (hp : p ∈ s) :
  (s.direction : set V) = (-ᵥ p) '' s :=
begin
  rw coe_direction_eq_vsub_set ⟨p, hp⟩,
  refine le_antisymm _ _,
  { rintros v ⟨p1, p2, hp1, hp2, rfl⟩,
    exact ⟨p1 -ᵥ p2 +ᵥ p,
           vadd_mem_of_mem_direction (vsub_mem_direction hp1 hp2) hp,
           (vadd_vsub _ _)⟩ },
  { rintros v ⟨p2, hp2, rfl⟩,
    exact ⟨p2, p, hp2, hp, rfl⟩ }
end

/-- Given a point in an affine subspace, the set of vectors in its
direction equals the set of vectors subtracting that point on the
left. -/
lemma coe_direction_eq_vsub_set_left {s : affine_subspace k P} {p : P} (hp : p ∈ s) :
  (s.direction : set V) = (-ᵥ) p '' s :=
begin
  ext v,
  rw [set_like.mem_coe, ←submodule.neg_mem_iff, ←set_like.mem_coe,
      coe_direction_eq_vsub_set_right hp, set.mem_image_iff_bex, set.mem_image_iff_bex],
  conv_lhs { congr, funext, rw [←neg_vsub_eq_vsub_rev, neg_inj] }
end

/-- Given a point in an affine subspace, a vector is in its direction
if and only if it results from subtracting that point on the right. -/
lemma mem_direction_iff_eq_vsub_right {s : affine_subspace k P} {p : P} (hp : p ∈ s) (v : V) :
  v ∈ s.direction ↔ ∃ p2 ∈ s, v = p2 -ᵥ p :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set_right hp],
  exact ⟨λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩, λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩⟩
end

/-- Given a point in an affine subspace, a vector is in its direction
if and only if it results from subtracting that point on the left. -/
lemma mem_direction_iff_eq_vsub_left {s : affine_subspace k P} {p : P} (hp : p ∈ s) (v : V) :
  v ∈ s.direction ↔ ∃ p2 ∈ s, v = p -ᵥ p2 :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set_left hp],
  exact ⟨λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩, λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩⟩
end

/-- Given a point in an affine subspace, a result of subtracting that
point on the right is in the direction if and only if the other point
is in the subspace. -/
lemma vsub_right_mem_direction_iff_mem {s : affine_subspace k P} {p : P} (hp : p ∈ s) (p2 : P) :
  p2 -ᵥ p ∈ s.direction ↔ p2 ∈ s :=
begin
  rw mem_direction_iff_eq_vsub_right hp,
  simp
end

/-- Given a point in an affine subspace, a result of subtracting that
point on the left is in the direction if and only if the other point
is in the subspace. -/
lemma vsub_left_mem_direction_iff_mem {s : affine_subspace k P} {p : P} (hp : p ∈ s) (p2 : P) :
  p -ᵥ p2 ∈ s.direction ↔ p2 ∈ s :=
begin
  rw mem_direction_iff_eq_vsub_left hp,
  simp
end

/-- Two affine subspaces are equal if they have the same points. -/
@[ext] lemma ext {s1 s2 : affine_subspace k P} (h : (s1 : set P) = s2) : s1 = s2 :=
begin
  cases s1,
  cases s2,
  congr,
  exact h
end

@[simp] lemma ext_iff (s₁ s₂ : affine_subspace k P) :
  (s₁ : set P) = s₂ ↔ s₁ = s₂ :=
⟨ext, by tidy⟩

/-- Two affine subspaces with the same direction and nonempty
intersection are equal. -/
lemma ext_of_direction_eq {s1 s2 : affine_subspace k P} (hd : s1.direction = s2.direction)
    (hn : ((s1 : set P) ∩ s2).nonempty) : s1 = s2 :=
begin
  ext p,
  have hq1 := set.mem_of_mem_inter_left hn.some_mem,
  have hq2 := set.mem_of_mem_inter_right hn.some_mem,
  split,
  { intro hp,
    rw ←vsub_vadd p hn.some,
    refine vadd_mem_of_mem_direction _ hq2,
    rw ←hd,
    exact vsub_mem_direction hp hq1 },
  { intro hp,
    rw ←vsub_vadd p hn.some,
    refine vadd_mem_of_mem_direction _ hq1,
    rw hd,
    exact vsub_mem_direction hp hq2 }
end

instance to_add_torsor (s : affine_subspace k P) [nonempty s] : add_torsor s.direction s :=
{ vadd := λ a b, ⟨(a:V) +ᵥ (b:P), vadd_mem_of_mem_direction a.2 b.2⟩,
  zero_vadd := by simp,
  add_vadd := λ a b c, by { ext, apply add_vadd },
  vsub := λ a b, ⟨(a:P) -ᵥ (b:P), (vsub_left_mem_direction_iff_mem a.2 _).mpr b.2 ⟩,
  nonempty := by apply_instance,
  vsub_vadd' := λ a b, by { ext, apply add_torsor.vsub_vadd' },
  vadd_vsub' := λ a b, by { ext, apply add_torsor.vadd_vsub' } }

@[simp, norm_cast] lemma coe_vsub (s : affine_subspace k P) [nonempty s] (a b : s) :
  ↑(a -ᵥ b) = (a:P) -ᵥ (b:P) :=
rfl

@[simp, norm_cast] lemma coe_vadd (s : affine_subspace k P) [nonempty s] (a : s.direction) (b : s) :
  ↑(a +ᵥ b) = (a:V) +ᵥ (b:P) :=
rfl

/-- Two affine subspaces with nonempty intersection are equal if and
only if their directions are equal. -/
lemma eq_iff_direction_eq_of_mem {s₁ s₂ : affine_subspace k P} {p : P} (h₁ : p ∈ s₁)
  (h₂ : p ∈ s₂) : s₁ = s₂ ↔ s₁.direction = s₂.direction :=
⟨λ h, h ▸ rfl, λ h, ext_of_direction_eq h ⟨p, h₁, h₂⟩⟩

/-- Construct an affine subspace from a point and a direction. -/
def mk' (p : P) (direction : submodule k V) : affine_subspace k P :=
{ carrier := {q | ∃ v ∈ direction, q = v +ᵥ p},
  smul_vsub_vadd_mem := λ c p1 p2 p3 hp1 hp2 hp3, begin
    rcases hp1 with ⟨v1, hv1, hp1⟩,
    rcases hp2 with ⟨v2, hv2, hp2⟩,
    rcases hp3 with ⟨v3, hv3, hp3⟩,
    use [c • (v1 - v2) + v3,
         direction.add_mem (direction.smul_mem c (direction.sub_mem hv1 hv2)) hv3],
    simp [hp1, hp2, hp3, vadd_vadd]
  end }

/-- An affine subspace constructed from a point and a direction contains
that point. -/
lemma self_mem_mk' (p : P) (direction : submodule k V) :
  p ∈ mk' p direction :=
⟨0, ⟨direction.zero_mem, (zero_vadd _ _).symm⟩⟩

/-- An affine subspace constructed from a point and a direction contains
the result of adding a vector in that direction to that point. -/
lemma vadd_mem_mk' {v : V} (p : P) {direction : submodule k V} (hv : v ∈ direction) :
  v +ᵥ p ∈ mk' p direction :=
⟨v, hv, rfl⟩

/-- An affine subspace constructed from a point and a direction is
nonempty. -/
lemma mk'_nonempty (p : P) (direction : submodule k V) : (mk' p direction : set P).nonempty :=
⟨p, self_mem_mk' p direction⟩

/-- The direction of an affine subspace constructed from a point and a
direction. -/
@[simp] lemma direction_mk' (p : P) (direction : submodule k V) :
  (mk' p direction).direction = direction :=
begin
  ext v,
  rw mem_direction_iff_eq_vsub (mk'_nonempty _ _),
  split,
  { rintros ⟨p1, ⟨v1, hv1, hp1⟩, p2, ⟨v2, hv2, hp2⟩, hv⟩,
    rw [hv, hp1, hp2, vadd_vsub_vadd_cancel_right],
    exact direction.sub_mem  hv1 hv2 },
  { exact λ hv, ⟨v +ᵥ p, vadd_mem_mk' _ hv, p,
                 self_mem_mk' _ _, (vadd_vsub _ _).symm⟩ }
end

/-- Constructing an affine subspace from a point in a subspace and
that subspace's direction yields the original subspace. -/
@[simp] lemma mk'_eq {s : affine_subspace k P} {p : P} (hp : p ∈ s) : mk' p s.direction = s :=
ext_of_direction_eq (direction_mk' p s.direction)
                    ⟨p, set.mem_inter (self_mem_mk' _ _) hp⟩

/-- If an affine subspace contains a set of points, it contains the
`span_points` of that set. -/
lemma span_points_subset_coe_of_subset_coe {s : set P} {s1 : affine_subspace k P} (h : s ⊆ s1) :
  span_points k s ⊆ s1 :=
begin
  rintros p ⟨p1, hp1, v, hv, hp⟩,
  rw hp,
  have hp1s1 : p1 ∈ (s1 : set P) := set.mem_of_mem_of_subset hp1 h,
  refine vadd_mem_of_mem_direction _ hp1s1,
  have hs : vector_span k s ≤ s1.direction := vector_span_mono k h,
  rw set_like.le_def at hs,
  rw ←set_like.mem_coe,
  exact set.mem_of_mem_of_subset hv hs
end

end affine_subspace

lemma affine_map.line_map_mem
  {k V P : Type*} [ring k] [add_comm_group V] [module k V] [add_torsor V P]
  {Q : affine_subspace k P} {p₀ p₁ : P} (c : k) (h₀ : p₀ ∈ Q) (h₁ : p₁ ∈ Q) :
  affine_map.line_map p₀ p₁ c ∈ Q :=
begin
  rw affine_map.line_map_apply,
  exact Q.smul_vsub_vadd_mem c h₁ h₀ h₀,
end

section affine_span

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

/-- The affine span of a set of points is the smallest affine subspace
containing those points. (Actually defined here in terms of spans in
modules.) -/
def affine_span (s : set P) : affine_subspace k P :=
{ carrier := span_points k s,
  smul_vsub_vadd_mem := λ c p1 p2 p3 hp1 hp2 hp3,
    vadd_mem_span_points_of_mem_span_points_of_mem_vector_span k hp3
      ((vector_span k s).smul_mem c
        (vsub_mem_vector_span_of_mem_span_points_of_mem_span_points k hp1 hp2)) }

/-- The affine span, converted to a set, is `span_points`. -/
@[simp] lemma coe_affine_span (s : set P) :
  (affine_span k s : set P) = span_points k s :=
rfl

/-- A set is contained in its affine span. -/
lemma subset_affine_span (s : set P) : s ⊆ affine_span k s :=
subset_span_points k s

/-- The direction of the affine span is the `vector_span`. -/
lemma direction_affine_span (s : set P) : (affine_span k s).direction = vector_span k s :=
begin
  apply le_antisymm,
  { refine submodule.span_le.2 _,
    rintros v ⟨p1, p3, ⟨p2, hp2, v1, hv1, hp1⟩, ⟨p4, hp4, v2, hv2, hp3⟩, rfl⟩,
    rw [hp1, hp3, vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, set_like.mem_coe],
    exact (vector_span k s).sub_mem ((vector_span k s).add_mem hv1
      (vsub_mem_vector_span k hp2 hp4)) hv2 },
  { exact vector_span_mono k (subset_span_points k s) }
end

/-- A point in a set is in its affine span. -/
lemma mem_affine_span {p : P} {s : set P} (hp : p ∈ s) : p ∈ affine_span k s :=
mem_span_points k p s hp

end affine_span

namespace affine_subspace

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [S : affine_space V P]
include S

instance : complete_lattice (affine_subspace k P) :=
{ sup := λ s1 s2, affine_span k (s1 ∪ s2),
  le_sup_left := λ s1 s2, set.subset.trans (set.subset_union_left s1 s2)
                                           (subset_span_points k _),
  le_sup_right :=  λ s1 s2, set.subset.trans (set.subset_union_right s1 s2)
                                             (subset_span_points k _),
  sup_le := λ s1 s2 s3 hs1 hs2, span_points_subset_coe_of_subset_coe (set.union_subset hs1 hs2),
  inf := λ s1 s2, mk (s1 ∩ s2)
                     (λ c p1 p2 p3 hp1 hp2 hp3,
                       ⟨s1.smul_vsub_vadd_mem c hp1.1 hp2.1 hp3.1,
                       s2.smul_vsub_vadd_mem c hp1.2 hp2.2 hp3.2⟩),
  inf_le_left := λ _ _, set.inter_subset_left _ _,
  inf_le_right := λ _ _, set.inter_subset_right _ _,
  le_inf := λ _ _ _, set.subset_inter,
  top := { carrier := set.univ,
    smul_vsub_vadd_mem := λ _ _ _ _ _ _ _, set.mem_univ _ },
  le_top := λ _ _ _, set.mem_univ _,
  bot := { carrier := ∅,
    smul_vsub_vadd_mem := λ _ _ _ _, false.elim },
  bot_le := λ _ _, false.elim,
  Sup := λ s, affine_span k (⋃ s' ∈ s, (s' : set P)),
  Inf := λ s, mk (⋂ s' ∈ s, (s' : set P))
                 (λ c p1 p2 p3 hp1 hp2 hp3, set.mem_bInter_iff.2 $ λ s2 hs2,
                   s2.smul_vsub_vadd_mem c (set.mem_bInter_iff.1 hp1 s2 hs2)
                                           (set.mem_bInter_iff.1 hp2 s2 hs2)
                                           (set.mem_bInter_iff.1 hp3 s2 hs2)),
  le_Sup := λ _ _ h, set.subset.trans (set.subset_bUnion_of_mem h) (subset_span_points k _),
  Sup_le := λ _ _ h, span_points_subset_coe_of_subset_coe (set.bUnion_subset h),
  Inf_le := λ _ _, set.bInter_subset_of_mem,
  le_Inf := λ _ _, set.subset_bInter,
  .. partial_order.lift (coe : affine_subspace k P → set P) (λ _ _, ext) }

instance : inhabited (affine_subspace k P) := ⟨⊤⟩

/-- The `≤` order on subspaces is the same as that on the corresponding
sets. -/
lemma le_def (s1 s2 : affine_subspace k P) : s1 ≤ s2 ↔ (s1 : set P) ⊆ s2 :=
iff.rfl

/-- One subspace is less than or equal to another if and only if all
its points are in the second subspace. -/
lemma le_def' (s1 s2 : affine_subspace k P) : s1 ≤ s2 ↔ ∀ p ∈ s1, p ∈ s2 :=
iff.rfl

/-- The `<` order on subspaces is the same as that on the corresponding
sets. -/
lemma lt_def (s1 s2 : affine_subspace k P) : s1 < s2 ↔ (s1 : set P) ⊂ s2 :=
iff.rfl

/-- One subspace is not less than or equal to another if and only if
it has a point not in the second subspace. -/
lemma not_le_iff_exists (s1 s2 : affine_subspace k P) : ¬ s1 ≤ s2 ↔ ∃ p ∈ s1, p ∉ s2 :=
set.not_subset

/-- If a subspace is less than another, there is a point only in the
second. -/
lemma exists_of_lt {s1 s2 : affine_subspace k P} (h : s1 < s2) : ∃ p ∈ s2, p ∉ s1 :=
set.exists_of_ssubset h

/-- A subspace is less than another if and only if it is less than or
equal to the second subspace and there is a point only in the
second. -/
lemma lt_iff_le_and_exists (s1 s2 : affine_subspace k P) : s1 < s2 ↔ s1 ≤ s2 ∧ ∃ p ∈ s2, p ∉ s1 :=
by rw [lt_iff_le_not_le, not_le_iff_exists]

/-- If an affine subspace is nonempty and contained in another with
the same direction, they are equal. -/
lemma eq_of_direction_eq_of_nonempty_of_le {s₁ s₂ : affine_subspace k P}
  (hd : s₁.direction = s₂.direction) (hn : (s₁ : set P).nonempty) (hle : s₁ ≤ s₂) :
  s₁ = s₂ :=
let ⟨p, hp⟩ := hn in ext_of_direction_eq hd ⟨p, hp, hle hp⟩

variables (k V)

/-- The affine span is the `Inf` of subspaces containing the given
points. -/
lemma affine_span_eq_Inf (s : set P) : affine_span k s = Inf {s' | s ⊆ s'} :=
le_antisymm (span_points_subset_coe_of_subset_coe (set.subset_bInter (λ _ h, h)))
            (Inf_le (subset_span_points k _))

variables (P)

/-- The Galois insertion formed by `affine_span` and coercion back to
a set. -/
protected def gi : galois_insertion (affine_span k) (coe : affine_subspace k P → set P) :=
{ choice := λ s _, affine_span k s,
  gc := λ s1 s2, ⟨λ h, set.subset.trans (subset_span_points k s1) h,
                       span_points_subset_coe_of_subset_coe⟩,
  le_l_u := λ _, subset_span_points k _,
  choice_eq := λ _ _, rfl }

/-- The span of the empty set is `⊥`. -/
@[simp] lemma span_empty : affine_span k (∅ : set P) = ⊥ :=
(affine_subspace.gi k V P).gc.l_bot

/-- The span of `univ` is `⊤`. -/
@[simp] lemma span_univ : affine_span k (set.univ : set P) = ⊤ :=
eq_top_iff.2 $ subset_span_points k _

variables {k V P}

lemma _root_.affine_span_le {s : set P} {Q : affine_subspace k P} :
  affine_span k s ≤ Q ↔ s ⊆ (Q : set P) :=
(affine_subspace.gi k V P).gc _ _

variables (k V) {P}

/-- The affine span of a single point, coerced to a set, contains just
that point. -/
@[simp] lemma coe_affine_span_singleton (p : P) : (affine_span k ({p} : set P) : set P) = {p} :=
begin
  ext x,
  rw [mem_coe, ←vsub_right_mem_direction_iff_mem (mem_affine_span k (set.mem_singleton p)) _,
      direction_affine_span],
  simp
end

/-- A point is in the affine span of a single point if and only if
they are equal. -/
@[simp] lemma mem_affine_span_singleton (p1 p2 : P) :
  p1 ∈ affine_span k ({p2} : set P) ↔ p1 = p2 :=
by simp [←mem_coe]

/-- The span of a union of sets is the sup of their spans. -/
lemma span_union (s t : set P) : affine_span k (s ∪ t) = affine_span k s ⊔ affine_span k t :=
(affine_subspace.gi k V P).gc.l_sup

/-- The span of a union of an indexed family of sets is the sup of
their spans. -/
lemma span_Union {ι : Type*} (s : ι → set P) :
  affine_span k (⋃ i, s i) = ⨆ i, affine_span k (s i) :=
(affine_subspace.gi k V P).gc.l_supr

variables (P)

/-- `⊤`, coerced to a set, is the whole set of points. -/
@[simp] lemma top_coe : ((⊤ : affine_subspace k P) : set P) = set.univ :=
rfl

variables {P}

/-- All points are in `⊤`. -/
lemma mem_top (p : P) : p ∈ (⊤ : affine_subspace k P) :=
set.mem_univ p

variables (P)

/-- The direction of `⊤` is the whole module as a submodule. -/
@[simp] lemma direction_top : (⊤ : affine_subspace k P).direction = ⊤ :=
begin
  cases S.nonempty with p,
  ext v,
  refine ⟨imp_intro submodule.mem_top, λ hv, _⟩,
  have hpv : (v +ᵥ p -ᵥ p : V) ∈ (⊤ : affine_subspace k P).direction :=
    vsub_mem_direction (mem_top k V _) (mem_top k V _),
  rwa vadd_vsub at hpv
end

/-- `⊥`, coerced to a set, is the empty set. -/
@[simp] lemma bot_coe : ((⊥ : affine_subspace k P) : set P) = ∅ :=
rfl

lemma bot_ne_top : (⊥ : affine_subspace k P) ≠ ⊤ :=
begin
  intros contra,
  rw [← ext_iff, bot_coe, top_coe] at contra,
  exact set.empty_ne_univ contra,
end

instance : nontrivial (affine_subspace k P) := ⟨⟨⊥, ⊤, bot_ne_top k V P⟩⟩

lemma nonempty_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) : s.nonempty :=
begin
  rw ← set.ne_empty_iff_nonempty,
  rintros rfl,
  rw affine_subspace.span_empty at h,
  exact bot_ne_top k V P h,
end

/-- If the affine span of a set is `⊤`, then the vector span of the same set is the `⊤`. -/
lemma vector_span_eq_top_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) :
  vector_span k s = ⊤ :=
by rw [← direction_affine_span, h, direction_top]

/-- For a nonempty set, the affine span is `⊤` iff its vector span is `⊤`. -/
lemma affine_span_eq_top_iff_vector_span_eq_top_of_nonempty {s : set P} (hs : s.nonempty) :
  affine_span k s = ⊤ ↔ vector_span k s = ⊤ :=
begin
  refine ⟨vector_span_eq_top_of_affine_span_eq_top k V P, _⟩,
  intros h,
  suffices : nonempty (affine_span k s),
  { obtain ⟨p, hp : p ∈ affine_span k s⟩ := this,
    rw [eq_iff_direction_eq_of_mem hp (mem_top k V p), direction_affine_span, h, direction_top] },
  obtain ⟨x, hx⟩ := hs,
  exact ⟨⟨x, mem_affine_span k hx⟩⟩,
end

/-- For a non-trivial space, the affine span of a set is `⊤` iff its vector span is `⊤`. -/
lemma affine_span_eq_top_iff_vector_span_eq_top_of_nontrivial {s : set P} [nontrivial P] :
  affine_span k s = ⊤ ↔ vector_span k s = ⊤ :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { simp [hs, subsingleton_iff_bot_eq_top, add_torsor.subsingleton_iff V P, not_subsingleton], },
  { rw affine_span_eq_top_iff_vector_span_eq_top_of_nonempty k V P hs, },
end

lemma card_pos_of_affine_span_eq_top {ι : Type*} [fintype ι] {p : ι → P}
  (h : affine_span k (range p) = ⊤) :
  0 < fintype.card ι :=
begin
  obtain ⟨-, ⟨i, -⟩⟩ := nonempty_of_affine_span_eq_top k V P h,
  exact fintype.card_pos_iff.mpr ⟨i⟩,
end

variables {P}

/-- No points are in `⊥`. -/
lemma not_mem_bot (p : P) : p ∉ (⊥ : affine_subspace k P) :=
set.not_mem_empty p

variables (P)

/-- The direction of `⊥` is the submodule `⊥`. -/
@[simp] lemma direction_bot : (⊥ : affine_subspace k P).direction = ⊥ :=
by rw [direction_eq_vector_span, bot_coe, vector_span_def, vsub_empty, submodule.span_empty]

variables {k V P}

lemma subsingleton_of_subsingleton_span_eq_top {s : set P} (h₁ : s.subsingleton)
  (h₂ : affine_span k s = ⊤) : subsingleton P :=
begin
  obtain ⟨p, hp⟩ := affine_subspace.nonempty_of_affine_span_eq_top k V P h₂,
  have : s = {p}, { exact subset.antisymm (λ q hq, h₁ hq hp) (by simp [hp]), },
  rw [this, ← affine_subspace.ext_iff, affine_subspace.coe_affine_span_singleton,
    affine_subspace.top_coe, eq_comm, ← subsingleton_iff_singleton (mem_univ _)] at h₂,
  exact subsingleton_of_univ_subsingleton h₂,
end

lemma eq_univ_of_subsingleton_span_eq_top {s : set P} (h₁ : s.subsingleton)
  (h₂ : affine_span k s = ⊤) : s = (univ : set P) :=
begin
  obtain ⟨p, hp⟩ := affine_subspace.nonempty_of_affine_span_eq_top k V P h₂,
  have : s = {p}, { exact subset.antisymm (λ q hq, h₁ hq hp) (by simp [hp]), },
  rw [this, eq_comm, ← subsingleton_iff_singleton (mem_univ p), subsingleton_univ_iff],
  exact subsingleton_of_subsingleton_span_eq_top h₁ h₂,
end

/-- A nonempty affine subspace is `⊤` if and only if its direction is
`⊤`. -/
@[simp] lemma direction_eq_top_iff_of_nonempty {s : affine_subspace k P}
  (h : (s : set P).nonempty) : s.direction = ⊤ ↔ s = ⊤ :=
begin
  split,
  { intro hd,
    rw ←direction_top k V P at hd,
    refine ext_of_direction_eq hd _,
    simp [h] },
  { rintro rfl,
    simp }
end

/-- The inf of two affine subspaces, coerced to a set, is the
intersection of the two sets of points. -/
@[simp] lemma inf_coe (s1 s2 : affine_subspace k P) : ((s1 ⊓ s2) : set P) = s1 ∩ s2 :=
rfl

/-- A point is in the inf of two affine subspaces if and only if it is
in both of them. -/
lemma mem_inf_iff (p : P) (s1 s2 : affine_subspace k P) : p ∈ s1 ⊓ s2 ↔ p ∈ s1 ∧ p ∈ s2 :=
iff.rfl

/-- The direction of the inf of two affine subspaces is less than or
equal to the inf of their directions. -/
lemma direction_inf (s1 s2 : affine_subspace k P) :
  (s1 ⊓ s2).direction ≤ s1.direction ⊓ s2.direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact le_inf
    (Inf_le_Inf (λ p hp, trans (vsub_self_mono (inter_subset_left _ _)) hp))
    (Inf_le_Inf (λ p hp, trans (vsub_self_mono (inter_subset_right _ _)) hp))
end

/-- If two affine subspaces have a point in common, the direction of
their inf equals the inf of their directions. -/
lemma direction_inf_of_mem {s₁ s₂ : affine_subspace k P} {p : P} (h₁ : p ∈ s₁) (h₂ : p ∈ s₂) :
  (s₁ ⊓ s₂).direction = s₁.direction ⊓ s₂.direction :=
begin
  ext v,
  rw [submodule.mem_inf, ←vadd_mem_iff_mem_direction v h₁, ←vadd_mem_iff_mem_direction v h₂,
      ←vadd_mem_iff_mem_direction v ((mem_inf_iff p s₁ s₂).2 ⟨h₁, h₂⟩), mem_inf_iff]
end

/-- If two affine subspaces have a point in their inf, the direction
of their inf equals the inf of their directions. -/
lemma direction_inf_of_mem_inf {s₁ s₂ : affine_subspace k P} {p : P} (h : p ∈ s₁ ⊓ s₂) :
  (s₁ ⊓ s₂).direction = s₁.direction ⊓ s₂.direction :=
direction_inf_of_mem ((mem_inf_iff p s₁ s₂).1 h).1 ((mem_inf_iff p s₁ s₂).1 h).2

/-- If one affine subspace is less than or equal to another, the same
applies to their directions. -/
lemma direction_le {s1 s2 : affine_subspace k P} (h : s1 ≤ s2) : s1.direction ≤ s2.direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact vector_span_mono k h
end

/-- If one nonempty affine subspace is less than another, the same
applies to their directions -/
lemma direction_lt_of_nonempty {s1 s2 : affine_subspace k P} (h : s1 < s2)
    (hn : (s1 : set P).nonempty) : s1.direction < s2.direction :=
begin
  cases hn with p hp,
  rw lt_iff_le_and_exists at h,
  rcases h with ⟨hle, p2, hp2, hp2s1⟩,
  rw set_like.lt_iff_le_and_exists,
  use [direction_le hle, p2 -ᵥ p, vsub_mem_direction hp2 (hle hp)],
  intro hm,
  rw vsub_right_mem_direction_iff_mem hp p2 at hm,
  exact hp2s1 hm
end

/-- The sup of the directions of two affine subspaces is less than or
equal to the direction of their sup. -/
lemma sup_direction_le (s1 s2 : affine_subspace k P) :
  s1.direction ⊔ s2.direction ≤ (s1 ⊔ s2).direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact sup_le
    (Inf_le_Inf (λ p hp, set.subset.trans (vsub_self_mono (le_sup_left : s1 ≤ s1 ⊔ s2)) hp))
    (Inf_le_Inf (λ p hp, set.subset.trans (vsub_self_mono (le_sup_right : s2 ≤ s1 ⊔ s2)) hp))
end

/-- The sup of the directions of two nonempty affine subspaces with
empty intersection is less than the direction of their sup. -/
lemma sup_direction_lt_of_nonempty_of_inter_empty {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty) (he : (s1 ∩ s2 : set P) = ∅) :
  s1.direction ⊔ s2.direction < (s1 ⊔ s2).direction :=
begin
  cases h1 with p1 hp1,
  cases h2 with p2 hp2,
  rw set_like.lt_iff_le_and_exists,
  use [sup_direction_le s1 s2, p2 -ᵥ p1,
       vsub_mem_direction ((le_sup_right : s2 ≤ s1 ⊔ s2) hp2) ((le_sup_left : s1 ≤ s1 ⊔ s2) hp1)],
  intro h,
  rw submodule.mem_sup at h,
  rcases h with ⟨v1, hv1, v2, hv2, hv1v2⟩,
  rw [←sub_eq_zero, sub_eq_add_neg, neg_vsub_eq_vsub_rev, add_comm v1, add_assoc,
      ←vadd_vsub_assoc, ←neg_neg v2, add_comm, ←sub_eq_add_neg, ←vsub_vadd_eq_vsub_sub,
      vsub_eq_zero_iff_eq] at hv1v2,
  refine set.nonempty.ne_empty _ he,
  use [v1 +ᵥ p1, vadd_mem_of_mem_direction hv1 hp1],
  rw hv1v2,
  exact vadd_mem_of_mem_direction (submodule.neg_mem _ hv2) hp2
end

/-- If the directions of two nonempty affine subspaces span the whole
module, they have nonempty intersection. -/
lemma inter_nonempty_of_nonempty_of_sup_direction_eq_top {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty)
    (hd : s1.direction ⊔ s2.direction = ⊤) : ((s1 : set P) ∩ s2).nonempty :=
begin
  by_contradiction h,
  rw set.not_nonempty_iff_eq_empty at h,
  have hlt := sup_direction_lt_of_nonempty_of_inter_empty h1 h2 h,
  rw hd at hlt,
  exact not_top_lt hlt
end

/-- If the directions of two nonempty affine subspaces are complements
of each other, they intersect in exactly one point. -/
lemma inter_eq_singleton_of_nonempty_of_is_compl {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty)
    (hd : is_compl s1.direction s2.direction) : ∃ p, (s1 : set P) ∩ s2 = {p} :=
begin
  cases inter_nonempty_of_nonempty_of_sup_direction_eq_top h1 h2 hd.sup_eq_top with p hp,
  use p,
  ext q,
  rw set.mem_singleton_iff,
  split,
  { rintros ⟨hq1, hq2⟩,
    have hqp : q -ᵥ p ∈ s1.direction ⊓ s2.direction :=
      ⟨vsub_mem_direction hq1 hp.1, vsub_mem_direction hq2 hp.2⟩,
    rwa [hd.inf_eq_bot, submodule.mem_bot, vsub_eq_zero_iff_eq] at hqp },
  { exact λ h, h.symm ▸ hp }
end

/-- Coercing a subspace to a set then taking the affine span produces
the original subspace. -/
@[simp] lemma affine_span_coe (s : affine_subspace k P) : affine_span k (s : set P) = s :=
begin
  refine le_antisymm _ (subset_span_points _ _),
  rintros p ⟨p1, hp1, v, hv, rfl⟩,
  exact vadd_mem_of_mem_direction hv hp1
end

end affine_subspace

section affine_space'

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
variables {ι : Type*}
include V

open affine_subspace set

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the left. -/
lemma vector_span_eq_span_vsub_set_left {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ) p '' s) :=
begin
  rw vector_span_def,
  refine le_antisymm _ (submodule.span_mono _),
  { rw submodule.span_le,
    rintros v ⟨p1, p2, hp1, hp2, hv⟩,
    rw ←vsub_sub_vsub_cancel_left p1 p2 p at hv,
    rw [←hv, set_like.mem_coe, submodule.mem_span],
    exact λ m hm, submodule.sub_mem _ (hm ⟨p2, hp2, rfl⟩) (hm ⟨p1, hp1, rfl⟩) },
  { rintros v ⟨p2, hp2, hv⟩,
    exact ⟨p, p2, hp, hp2, hv⟩ }
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right. -/
lemma vector_span_eq_span_vsub_set_right {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ p) '' s) :=
begin
  rw vector_span_def,
  refine le_antisymm _ (submodule.span_mono _),
  { rw submodule.span_le,
    rintros v ⟨p1, p2, hp1, hp2, hv⟩,
    rw ←vsub_sub_vsub_cancel_right p1 p2 p at hv,
    rw [←hv, set_like.mem_coe, submodule.mem_span],
    exact λ m hm, submodule.sub_mem _ (hm ⟨p1, hp1, rfl⟩) (hm ⟨p2, hp2, rfl⟩) },
  { rintros v ⟨p2, hp2, hv⟩,
    exact ⟨p2, p, hp2, hp, hv⟩ }
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the left, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_set_left_ne {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ) p '' (s \ {p})) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_left k hp, ←set.insert_eq_of_mem hp,
                 ←set.insert_diff_singleton, set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_set_right_ne {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ p) '' (s \ {p})) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_right k hp, ←set.insert_eq_of_mem hp,
                 ←set.insert_diff_singleton, set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_finset_right_ne {s : finset P} {p : P} (hp : p ∈ s) :
  vector_span k (s : set P) = submodule.span k ((s.erase p).image (-ᵥ p)) :=
by simp [vector_span_eq_span_vsub_set_right_ne _ (finset.mem_coe.mpr hp)]

/-- The `vector_span` of the image of a function is the span of the
pairwise subtractions with a given point on the left, excluding the
subtraction of that point from itself. -/
lemma vector_span_image_eq_span_vsub_set_left_ne (p : ι → P) {s : set ι} {i : ι} (hi : i ∈ s) :
  vector_span k (p '' s) = submodule.span k ((-ᵥ) (p i) '' (p '' (s \ {i}))) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_left k (set.mem_image_of_mem p hi),
                 ←set.insert_eq_of_mem hi, ←set.insert_diff_singleton, set.image_insert_eq,
                 set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` of the image of a function is the span of the
pairwise subtractions with a given point on the right, excluding the
subtraction of that point from itself. -/
lemma vector_span_image_eq_span_vsub_set_right_ne (p : ι → P) {s : set ι} {i : ι} (hi : i ∈ s) :
  vector_span k (p '' s) = submodule.span k ((-ᵥ (p i)) '' (p '' (s \ {i}))) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_right k (set.mem_image_of_mem p hi),
                 ←set.insert_eq_of_mem hi, ←set.insert_diff_singleton, set.image_insert_eq,
                 set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the left. -/
lemma vector_span_range_eq_span_range_vsub_left (p : ι → P) (i0 : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : ι), p i0 -ᵥ p i)) :=
by rw [vector_span_eq_span_vsub_set_left k (set.mem_range_self i0), ←set.range_comp]

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the right. -/
lemma vector_span_range_eq_span_range_vsub_right (p : ι → P) (i0 : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : ι), p i -ᵥ p i0)) :=
by rw [vector_span_eq_span_vsub_set_right k (set.mem_range_self i0), ←set.range_comp]

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the left, excluding the subtraction
of that point from itself. -/
lemma vector_span_range_eq_span_range_vsub_left_ne (p : ι → P) (i₀ : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : {x // x ≠ i₀}), p i₀ -ᵥ p i)) :=
begin
  rw [←set.image_univ, vector_span_image_eq_span_vsub_set_left_ne k _ (set.mem_univ i₀)],
  congr' with v,
  simp only [set.mem_range, set.mem_image, set.mem_diff, set.mem_singleton_iff, subtype.exists,
             subtype.coe_mk],
  split,
  { rintros ⟨x, ⟨i₁, ⟨⟨hi₁u, hi₁⟩, rfl⟩⟩, hv⟩,
    exact ⟨i₁, hi₁, hv⟩ },
  { exact λ ⟨i₁, hi₁, hv⟩, ⟨p i₁, ⟨i₁, ⟨set.mem_univ _, hi₁⟩, rfl⟩, hv⟩ }
end

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the right, excluding the subtraction
of that point from itself. -/
lemma vector_span_range_eq_span_range_vsub_right_ne (p : ι → P) (i₀ : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : {x // x ≠ i₀}), p i -ᵥ p i₀)) :=
begin
  rw [←set.image_univ, vector_span_image_eq_span_vsub_set_right_ne k _ (set.mem_univ i₀)],
  congr' with v,
  simp only [set.mem_range, set.mem_image, set.mem_diff, set.mem_singleton_iff, subtype.exists,
             subtype.coe_mk],
  split,
  { rintros ⟨x, ⟨i₁, ⟨⟨hi₁u, hi₁⟩, rfl⟩⟩, hv⟩,
    exact ⟨i₁, hi₁, hv⟩ },
  { exact λ ⟨i₁, hi₁, hv⟩, ⟨p i₁, ⟨i₁, ⟨set.mem_univ _, hi₁⟩, rfl⟩, hv⟩ }
end

/-- The affine span of a set is nonempty if and only if that set
is. -/
lemma affine_span_nonempty (s : set P) :
  (affine_span k s : set P).nonempty ↔ s.nonempty :=
span_points_nonempty k s

/-- The affine span of a nonempty set is nonempty. -/
instance {s : set P} [nonempty s] : nonempty (affine_span k s) :=
((affine_span_nonempty k s).mpr (nonempty_subtype.mp ‹_›)).to_subtype

variables {k}

/-- Suppose a set of vectors spans `V`.  Then a point `p`, together
with those vectors added to `p`, spans `P`. -/
lemma affine_span_singleton_union_vadd_eq_top_of_span_eq_top {s : set V} (p : P)
    (h : submodule.span k (set.range (coe : s → V)) = ⊤) :
  affine_span k ({p} ∪ (λ v, v +ᵥ p) '' s) = ⊤ :=
begin
  convert ext_of_direction_eq _
    ⟨p,
     mem_affine_span k (set.mem_union_left _ (set.mem_singleton _)),
     mem_top k V p⟩,
  rw [direction_affine_span, direction_top,
      vector_span_eq_span_vsub_set_right k
        ((set.mem_union_left _ (set.mem_singleton _)) : p ∈ _), eq_top_iff, ←h],
  apply submodule.span_mono,
  rintros v ⟨v', rfl⟩,
  use (v' : V) +ᵥ p,
  simp
end

variables (k)

/-- `affine_span` is monotone. -/
@[mono]
lemma affine_span_mono {s₁ s₂ : set P} (h : s₁ ⊆ s₂) : affine_span k s₁ ≤ affine_span k s₂ :=
span_points_subset_coe_of_subset_coe (set.subset.trans h (subset_affine_span k _))

/-- Taking the affine span of a set, adding a point and taking the
span again produces the same results as adding the point to the set
and taking the span. -/
lemma affine_span_insert_affine_span (p : P) (ps : set P) :
  affine_span k (insert p (affine_span k ps : set P)) = affine_span k (insert p ps) :=
by rw [set.insert_eq, set.insert_eq, span_union, span_union, affine_span_coe]

/-- If a point is in the affine span of a set, adding it to that set
does not change the affine span. -/
lemma affine_span_insert_eq_affine_span {p : P} {ps : set P} (h : p ∈ affine_span k ps) :
  affine_span k (insert p ps) = affine_span k ps :=
begin
  rw ←mem_coe at h,
  rw [←affine_span_insert_affine_span, set.insert_eq_of_mem h, affine_span_coe]
end

end affine_space'

namespace affine_subspace

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

/-- The direction of the sup of two nonempty affine subspaces is the
sup of the two directions and of any one difference between points in
the two subspaces. -/
lemma direction_sup {s1 s2 : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s1) (hp2 : p2 ∈ s2) :
  (s1 ⊔ s2).direction = s1.direction ⊔ s2.direction ⊔ k ∙ (p2 -ᵥ p1) :=
begin
  refine le_antisymm _ _,
  { change (affine_span k ((s1 : set P) ∪ s2)).direction ≤ _,
    rw ←mem_coe at hp1,
    rw [direction_affine_span, vector_span_eq_span_vsub_set_right k (set.mem_union_left _ hp1),
        submodule.span_le],
    rintros v ⟨p3, hp3, rfl⟩,
    cases hp3,
    { rw [sup_assoc, sup_comm, set_like.mem_coe, submodule.mem_sup],
      use [0, submodule.zero_mem _, p3 -ᵥ p1, vsub_mem_direction hp3 hp1],
      rw zero_add },
    { rw [sup_assoc, set_like.mem_coe, submodule.mem_sup],
      use [0, submodule.zero_mem _, p3 -ᵥ p1],
      rw [and_comm, zero_add],
      use rfl,
      rw [←vsub_add_vsub_cancel p3 p2 p1, submodule.mem_sup],
      use [p3 -ᵥ p2, vsub_mem_direction hp3 hp2, p2 -ᵥ p1,
           submodule.mem_span_singleton_self _] } },
  { refine sup_le (sup_direction_le _ _) _,
    rw [direction_eq_vector_span, vector_span_def],
    exact Inf_le_Inf (λ p hp, set.subset.trans
      (set.singleton_subset_iff.2
        (vsub_mem_vsub (mem_span_points k p2 _ (set.mem_union_right _ hp2))
                       (mem_span_points k p1 _ (set.mem_union_left _ hp1))))
      hp) }
end

/-- The direction of the span of the result of adding a point to a
nonempty affine subspace is the sup of the direction of that subspace
and of any one difference between that point and a point in the
subspace. -/
lemma direction_affine_span_insert {s : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s) :
  (affine_span k (insert p2 (s : set P))).direction = submodule.span k {p2 -ᵥ p1} ⊔ s.direction :=
begin
  rw [sup_comm, ←set.union_singleton, ←coe_affine_span_singleton k V p2],
  change (s ⊔ affine_span k {p2}).direction = _,
  rw [direction_sup hp1 (mem_affine_span k (set.mem_singleton _)), direction_affine_span],
  simp
end

/-- Given a point `p1` in an affine subspace `s`, and a point `p2`, a
point `p` is in the span of `s` with `p2` added if and only if it is a
multiple of `p2 -ᵥ p1` added to a point in `s`. -/
lemma mem_affine_span_insert_iff {s : affine_subspace k P} {p1 : P} (hp1 : p1 ∈ s) (p2 p : P) :
  p ∈ affine_span k (insert p2 (s : set P)) ↔
    ∃ (r : k) (p0 : P) (hp0 : p0 ∈ s), p = r • (p2 -ᵥ p1 : V) +ᵥ p0 :=
begin
  rw ←mem_coe at hp1,
  rw [←vsub_right_mem_direction_iff_mem (mem_affine_span k (set.mem_insert_of_mem _ hp1)),
      direction_affine_span_insert hp1, submodule.mem_sup],
  split,
  { rintros ⟨v1, hv1, v2, hv2, hp⟩,
    rw submodule.mem_span_singleton at hv1,
    rcases hv1 with ⟨r, rfl⟩,
    use [r, v2 +ᵥ p1, vadd_mem_of_mem_direction hv2 hp1],
    symmetry' at hp,
    rw [←sub_eq_zero, ←vsub_vadd_eq_vsub_sub, vsub_eq_zero_iff_eq] at hp,
    rw [hp, vadd_vadd] },
  { rintros ⟨r, p3, hp3, rfl⟩,
    use [r • (p2 -ᵥ p1), submodule.mem_span_singleton.2 ⟨r, rfl⟩, p3 -ᵥ p1,
         vsub_mem_direction hp3 hp1],
    rw [vadd_vsub_assoc, add_comm] }
end

end affine_subspace

section maps

variables {k V₁ P₁ V₂ P₂ : Type*} [ring k]
variables [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
variables [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
include V₁ V₂

variables (f : P₁ →ᵃ[k] P₂)

@[simp] lemma affine_map.vector_span_image_eq_submodule_map {s : set P₁} :
  submodule.map f.linear (vector_span k s) = vector_span k (f '' s) :=
by simp [f.image_vsub_image, vector_span_def]

namespace affine_subspace

/-- The image of an affine subspace under an affine map as an affine subspace. -/
def map (s : affine_subspace k P₁) : affine_subspace k P₂ :=
{ carrier := f '' s,
  smul_vsub_vadd_mem :=
    begin
      rintros t - - - ⟨p₁, h₁, rfl⟩ ⟨p₂, h₂, rfl⟩ ⟨p₃, h₃, rfl⟩,
      use t • (p₁ -ᵥ p₂) +ᵥ p₃,
      suffices : t • (p₁ -ᵥ p₂) +ᵥ p₃ ∈ s, { by simp [this], },
      exact s.smul_vsub_vadd_mem t h₁ h₂ h₃,
    end }

@[simp] lemma map_coe (s : affine_subspace k P₁) : (s.map f : set P₂) = f '' s := rfl

@[simp] lemma map_bot : (⊥ : affine_subspace k P₁).map f = ⊥ :=
by { rw ← ext_iff, exact image_empty f, }

@[simp] lemma map_direction (s : affine_subspace k P₁) :
  (s.map f).direction = s.direction.map f.linear :=
by simp [direction_eq_vector_span]

lemma map_span (s : set P₁) :
  (affine_span k s).map f = affine_span k (f '' s) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨p, hp⟩, { simp, },
  apply ext_of_direction_eq,
  { simp [direction_affine_span], },
  { exact ⟨f p, mem_image_of_mem f (subset_affine_span k _ hp),
                subset_affine_span k _ (mem_image_of_mem f hp)⟩, },
end

end affine_subspace

namespace affine_map

@[simp] lemma map_top_of_surjective (hf : function.surjective f) : affine_subspace.map f ⊤ = ⊤ :=
begin
  rw ← affine_subspace.ext_iff,
  exact image_univ_of_surjective hf,
end

lemma span_eq_top_of_surjective {s : set P₁}
  (hf : function.surjective f) (h : affine_span k s = ⊤) :
  affine_span k (f '' s) = ⊤ :=
by rw [← affine_subspace.map_span, h, map_top_of_surjective f hf]

end affine_map

lemma affine_equiv.span_eq_top_iff {s : set P₁} (e : P₁ ≃ᵃ[k] P₂) :
  affine_span k s = ⊤ ↔ affine_span k (e '' s) = ⊤ :=
begin
  refine ⟨(e : P₁ →ᵃ[k] P₂).span_eq_top_of_surjective e.surjective, _⟩,
  intros h,
  have : s = e.symm '' (e '' s), { simp [← image_comp], },
  rw this,
  exact (e.symm : P₂ →ᵃ[k] P₁).span_eq_top_of_surjective e.symm.surjective h,
end

end maps