import data.real.basic
import tactic
open function real

namespace vilnius

/-- Composite of two injective functions is injective -/
theorem injective_comp (X Y Z : Type) (f : X → Y) (g : Y → Z)
  (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  intros x y H,
  apply hf,
  apply hg,
  exact H,
end

/- ## The λ notation:
In Lean (or in Type Theory, rather) the way to define a function is to use λ expressions: here, you should think that `λ = ∀`: so, the function
`λ x, 3*x ^ 2 + 1`
is nothing else that the function
`f(x)=3*x ^ 2 + 1` or `f : x ↦ 3*x ^ 2 + 1`.

As for usual functions, the name of the variable does not matter, so
`λ x, 3*x ^ 2 + 1` is the same as `λ w, 3*w ^ 2 + 1`

The tactic to get rid of a `λ` term is
* `simp only` (possibly: at h)
because it "evaluates a λ-term", transforming, for instance
`(λ x, 2 * x + 1) 3` into `2 * 3 + 1`.
-/

theorem injective_id (X : Type) : injective (λ x : X, x) :=
begin
  intros x y h,
  simp only at h,
  exact h,
end

definition is_linear (f : ℝ → ℝ) : Prop := ∀ c x y, f (c * x + y) = c * f (x) + f(y)

theorem linear_at_0 (f : ℝ → ℝ) (H : is_linear f) : f 0 = 0 :=
begin
  have hf := H 1 0 0,
  rewrite one_mul at hf,
  rewrite one_mul at hf,
  rewrite add_zero at hf,
  apply self_eq_add_left.mp hf,
end

theorem linear_explicit (f : ℝ → ℝ) (H : is_linear f) : ∃ a, f = λ x, a * x :=
begin
  use f 1,
  ext, --***ATTENZIONE***
  rw ← mul_one x,
  have := H x 1 0,
  rw linear_at_0 f H at this,
  rw add_zero at this,
  rw add_zero at this,
  rw this,
  rw mul_comm,
  rw mul_one,
end

definition is_affine (f : ℝ → ℝ) : Prop := ∃ a, ∀ x y, f (y) - f(x) = a * (y - x)

theorem linear_add_cnst_of_affine (f : ℝ → ℝ) : is_affine f → (∃ a : ℝ, ∃ g : ℝ → ℝ, (f = g + (λ x, a)) ∧ is_linear g) :=
begin
  intro hf,
  obtain ⟨a, h_aff⟩ := hf,
  use f 0,
  let g := f - (λ n, f 0),
  use g,
  split,
  simp only [sub_add_cancel], --***ATTENZIONE***
  intros c x y,
  simp [g],
  -- simp only [pi.sub_apply], --***ATTENZIONE***
  have h1 := h_aff 0 (c*x + y),
  rw h_aff,
  have h2 := h_aff 0 y,
  have h3 := h_aff 0 x,
  rw h2,
  rw h3,
  ring, --***ATTENZIONE***
end

theorem affine_of_linear_add_cnst (f : ℝ → ℝ) : (∃ b : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, b)) ∧ is_linear g) → is_affine f :=
begin
  intro H,
  obtain ⟨b, g, hf1, hg1⟩ := H, --***ATTENZIONE ALLA SINTASSI TRIPLA***
  simp [is_affine],
  obtain ⟨a, hg2⟩ := linear_explicit g hg1,
  use a,
  intros x y,
  rw hf1,
  simp only [add_sub_add_right_eq_sub, pi.add_apply], --***SERVE DAVVERO SIMP***
  rw hg2,
  simp only,
  rw mul_sub,
end

end vilnius


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import data.fintype.basic
import data.int.parity
import algebra.big_operators.order
import tactic.ring
import tactic.noncomm_ring

/-!
# IMO 1998 Q2
In a competition, there are `a` contestants and `b` judges, where `b ≥ 3` is an odd integer. Each
judge rates each contestant as either "pass" or "fail". Suppose `k` is a number such that, for any
two judges, their ratings coincide for at most `k` contestants. Prove that `k / a ≥ (b - 1) / (2b)`.

## Solution
The problem asks us to think about triples consisting of a contestant and two judges whose ratings
agree for that contestant. We thus consider the subset `A ⊆ C × JJ` of all such incidences of
agreement, where `C` and `J` are the sets of contestants and judges, and `JJ = J × J − {(j, j)}`. We
have natural maps: `left : A → C` and `right: A → JJ`. We count the elements of `A` in two ways: as
the sum of the cardinalities of the fibres of `left` and as the sum of the cardinalities of the
fibres of `right`. We obtain an upper bound on the cardinality of `A` from the count for `right`,
and a lower bound from the count for `left`. These two bounds combine to the required result.

First consider the map `right : A → JJ`. Since the size of any fibre over a point in JJ is bounded
by `k` and since `|JJ| = b^2 - b`, we obtain the upper bound: `|A| ≤ k(b^2−b)`.

Now consider the map `left : A → C`. The fibre over a given contestant `c ∈ C` is the set of
ordered pairs of (distinct) judges who agree about `c`. We seek to bound the cardinality of this
fibre from below. Minimum agreement for a contestant occurs when the judges' ratings are split as
evenly as possible. Since `b` is odd, this occurs when they are divided into groups of size
`(b−1)/2` and `(b+1)/2`. This corresponds to a fibre of cardinality `(b-1)^2/2` and so we obtain
the lower bound: `a(b-1)^2/2 ≤ |A|`.

Rearranging gives the result.
-/

open_locale classical
noncomputable theory

/-- An ordered pair of judges. -/
abbreviation judge_pair (J : Type*) := J × J

/-- A triple consisting of contestant together with an ordered pair of judges. -/
abbreviation agreed_triple (C J : Type*) := C × (judge_pair J)

variables {C J : Type*} (r : C → J → Prop)

/-- The first judge from an ordered pair of judges. -/
abbreviation judge_pair.judge₁ : judge_pair J → J := prod.fst

/-- The second judge from an ordered pair of judges. -/
abbreviation judge_pair.judge₂ : judge_pair J → J := prod.snd

/-- The proposition that the judges in an ordered pair are distinct. -/
abbreviation judge_pair.distinct (p : judge_pair J) := p.judge₁ ≠ p.judge₂

/-- The proposition that the judges in an ordered pair agree about a contestant's rating. -/
abbreviation judge_pair.agree (p : judge_pair J) (c : C) := r c p.judge₁ ↔ r c p.judge₂

/-- The contestant from the triple consisting of a contestant and an ordered pair of judges. -/
abbreviation agreed_triple.contestant : agreed_triple C J → C := prod.fst

/-- The ordered pair of judges from the triple consisting of a contestant and an ordered pair of
judges. -/
abbreviation agreed_triple.judge_pair : agreed_triple C J → judge_pair J := prod.snd

@[simp] lemma judge_pair.agree_iff_same_rating (p : judge_pair J) (c : C) :
  p.agree r c ↔ (r c p.judge₁ ↔ r c p.judge₂) := iff.rfl

/-- The set of contestants on which two judges agree. -/
def agreed_contestants [fintype C] (p : judge_pair J) : finset C :=
finset.univ.filter (λ c, p.agree r c)

section

variables [fintype J] [fintype C]

/-- All incidences of agreement. -/
def A : finset (agreed_triple C J) := finset.univ.filter (λ (a : agreed_triple C J),
  a.judge_pair.agree r a.contestant ∧ a.judge_pair.distinct)

lemma A_maps_to_off_diag_judge_pair (a : agreed_triple C J) :
  a ∈ A r → a.judge_pair ∈ finset.off_diag (@finset.univ J _) :=
by simp [A, finset.mem_off_diag]

lemma A_fibre_over_contestant (c : C) :
  finset.univ.filter (λ (p : judge_pair J), p.agree r c ∧ p.distinct) =
  ((A r).filter (λ (a : agreed_triple C J), a.contestant = c)).image prod.snd :=
begin
  ext p,
  simp only [A, finset.mem_univ, finset.mem_filter, finset.mem_image, true_and, exists_prop],
  split,
  { rintros ⟨h₁, h₂⟩, refine ⟨(c, p), _⟩, finish, },
  { intros h, finish, },
end

lemma A_fibre_over_contestant_card (c : C) :
  (finset.univ.filter (λ (p : judge_pair J), p.agree r c ∧ p.distinct)).card =
  ((A r).filter (λ (a : agreed_triple C J), a.contestant = c)).card :=
by { rw A_fibre_over_contestant r, apply finset.card_image_of_inj_on, tidy, }

lemma A_fibre_over_judge_pair {p : judge_pair J} (h : p.distinct) :
  agreed_contestants r p =
  ((A r).filter(λ (a : agreed_triple C J), a.judge_pair = p)).image agreed_triple.contestant :=
begin
  dunfold A agreed_contestants, ext c, split; intros h,
  { rw finset.mem_image, refine ⟨⟨c, p⟩, _⟩, finish, },
  { finish, },
end

lemma A_fibre_over_judge_pair_card {p : judge_pair J} (h : p.distinct) :
  (agreed_contestants r p).card =
  ((A r).filter(λ (a : agreed_triple C J), a.judge_pair = p)).card :=
by { rw A_fibre_over_judge_pair r h, apply finset.card_image_of_inj_on, tidy, }

lemma A_card_upper_bound
  {k : ℕ} (hk : ∀ (p : judge_pair J), p.distinct → (agreed_contestants r p).card ≤ k) :
  (A r).card ≤ k * ((fintype.card J) * (fintype.card J) - (fintype.card J)) :=
begin
  change _ ≤ k * ((finset.card _ ) * (finset.card _ ) - (finset.card _ )),
  rw ← finset.off_diag_card,
  apply finset.card_le_mul_card_image_of_maps_to (A_maps_to_off_diag_judge_pair r),
  intros p hp,
  have hp' : p.distinct, { simp [finset.mem_off_diag] at hp, exact hp, },
  rw ← A_fibre_over_judge_pair_card r hp', apply hk, exact hp',
end

end

lemma add_sq_add_sq_sub {α : Type*} [ring α] (x y : α) :
  (x + y) * (x + y) + (x - y) * (x - y) = 2*x*x + 2*y*y :=
by noncomm_ring

lemma norm_bound_of_odd_sum {x y z : ℤ} (h : x + y = 2*z + 1) :
  2*z*z + 2*z + 1 ≤ x*x + y*y :=
begin
  suffices : 4*z*z + 4*z + 1 + 1 ≤ 2*x*x + 2*y*y,
  { rw ← mul_le_mul_left (@zero_lt_two _ _ int.nontrivial), convert this; ring, },
  have h' : (x + y) * (x + y) = 4*z*z + 4*z + 1, { rw h, ring, },
  rw [← add_sq_add_sq_sub, h', add_le_add_iff_left],
  suffices : 0 < (x - y) * (x - y), { apply int.add_one_le_of_lt this, },
  apply mul_self_pos, rw sub_ne_zero, apply int.ne_of_odd_add ⟨z, h⟩,
end

section

variables [fintype J]

lemma judge_pairs_card_lower_bound {z : ℕ} (hJ : fintype.card J = 2*z + 1) (c : C) :
  2*z*z + 2*z + 1 ≤ (finset.univ.filter (λ (p : judge_pair J), p.agree r c)).card :=
begin
  let x := (finset.univ.filter (λ j, r c j)).card,
  let y := (finset.univ.filter (λ j, ¬ r c j)).card,
  have h : (finset.univ.filter (λ (p : judge_pair J), p.agree r c)).card = x*x + y*y,
  { simp [← finset.filter_product_card], },
  rw h, apply int.le_of_coe_nat_le_coe_nat, simp only [int.coe_nat_add, int.coe_nat_mul],
  apply norm_bound_of_odd_sum,
  suffices : x + y = 2*z + 1, { simp [← int.coe_nat_add, this], },
  rw [finset.filter_card_add_filter_neg_card_eq_card, ← hJ], refl,
end

lemma distinct_judge_pairs_card_lower_bound {z : ℕ} (hJ : fintype.card J = 2*z + 1) (c : C) :
  2*z*z ≤ (finset.univ.filter (λ (p : judge_pair J), p.agree r c ∧ p.distinct)).card :=
begin
  let s := finset.univ.filter (λ (p : judge_pair J), p.agree r c),
  let t := finset.univ.filter (λ (p : judge_pair J), p.distinct),
  have hs : 2*z*z + 2*z + 1 ≤ s.card, { exact judge_pairs_card_lower_bound r hJ c, },
  have hst : s \ t = finset.univ.diag,
  { ext p, split; intros,
    { finish, },
    { suffices : p.judge₁ = p.judge₂, { simp [this], }, finish, }, },
  have hst' : (s \ t).card = 2*z + 1, { rw [hst, finset.diag_card, ← hJ], refl, },
  rw [finset.filter_and, ← finset.sdiff_sdiff_self_left s t, finset.card_sdiff],
  { rw hst', rw add_assoc at hs, apply nat.le_sub_right_of_add_le hs, },
  { apply finset.sdiff_subset, },
end

lemma A_card_lower_bound [fintype C] {z : ℕ} (hJ : fintype.card J = 2*z + 1) :
  2*z*z * (fintype.card C) ≤ (A r).card :=
begin
  have h : ∀ a, a ∈ A r → prod.fst a ∈ @finset.univ C _, { intros, apply finset.mem_univ, },
  apply finset.mul_card_image_le_card_of_maps_to h,
  intros c hc,
  rw ← A_fibre_over_contestant_card,
  apply distinct_judge_pairs_card_lower_bound r hJ,
end

end

local notation x `/` y := (x : ℚ) / y

lemma clear_denominators {a b k : ℕ} (ha : 0 < a) (hb : 0 < b) :
  (b - 1) / (2 * b) ≤ k / a ↔ (b - 1) * a ≤ k * (2 * b) :=
by rw div_le_div_iff; norm_cast; simp [ha, hb]

theorem imo1998_q2 [fintype J] [fintype C]
  (a b k : ℕ) (hC : fintype.card C = a) (hJ : fintype.card J = b) (ha : 0 < a) (hb : odd b)
  (hk : ∀ (p : judge_pair J), p.distinct → (agreed_contestants r p).card ≤ k) :
  (b - 1) / (2 * b) ≤ k / a :=
begin
  rw clear_denominators ha (nat.odd_gt_zero hb),
  obtain ⟨z, hz⟩ := hb, rw hz at hJ, rw hz,
  have h := le_trans (A_card_lower_bound r hJ) (A_card_upper_bound r hk),
  rw [hC, hJ] at h,
  -- We are now essentially done; we just need to bash `h` into exactly the right shape.
  have hl : k * ((2 * z + 1) * (2 * z + 1) - (2 * z + 1)) = (k * (2 * (2 * z + 1))) * z,
  { simp only [add_mul, two_mul, mul_comm, mul_assoc], finish, },
  have hr : 2 * z * z * a = 2 * z * a * z, { ring, },
  rw [hl, hr] at h,
  cases z,
  { simp, },
  { exact le_of_mul_le_mul_right h z.succ_pos, },
end


-- Reglas de la conjunción
-- =======================

-- Ej. 1. Demostrar que
--    P ∧ Q → Q ∧ P

import tactic

variables (P Q : Prop)

-- 1ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from and.left h,
have hQ : Q,
  from and.right h,
show Q ∧ P,
  from and.intro hQ hP

-- 2ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from h.left,
have hQ : Q,
  from h.right,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 3ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P,
  from h.1,
have hQ : Q,
  from h.2,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 4ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have hP : P := h.1,
have hQ : Q := h.2,
show Q ∧ P,
  from ⟨hQ, hP⟩

-- 5ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
show Q ∧ P,
  from ⟨h.2, h.1⟩

-- 6ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q, ⟨h.2, h.1⟩

-- 7ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
λ h, ⟨h.2,h.1⟩

-- 8ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
and.comm.mp

-- 9ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
begin
  intro h,
  cases h with hP hQ,
  split,
  { exact hQ, },
  { exact hP, },
end

-- 10ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
begin
  rintro ⟨hP, hQ⟩,
  exact ⟨hQ, hP⟩,
end

-- 11ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
λ ⟨hP, hQ⟩, ⟨hQ, hP⟩

-- 12ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
by tauto

-- 13ª demostración
-- ===============

example : P ∧ Q → Q ∧ P :=
by finish


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import ring_theory.integral_closure
import ring_theory.localization

/-!
# Integrally closed rings

An integrally closed domain `R` contains all the elements of `Frac(R)` that are
integral over `R`. A special case of integrally closed domains are the Dedekind domains.

## Main definitions

* `is_integrally_closed R` states `R` contains all integral elements of `Frac(R)`

## Main results

* `is_integrally_closed_iff K`, where `K` is a fraction field of `R`, states `R`
  is integrally closed iff it is the integral closure of `R` in `K`
-/

open_locale non_zero_divisors

/-- `R` is integrally closed if all integral elements of `Frac(R)` are also elements of `R`.

This definition uses `fraction_ring R` to denote `Frac(R)`. See `is_integrally_closed_iff`
if you want to choose another field of fractions for `R`.
-/
class is_integrally_closed (R : Type*) [comm_ring R] [is_domain R] : Prop :=
(algebra_map_eq_of_integral :
  ∀ {x : fraction_ring R}, is_integral R x → ∃ y, algebra_map R (fraction_ring R) y = x)

section iff

variables {R : Type*} [comm_ring R] [is_domain R]
variables (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]

/-- `R` is integrally closed iff all integral elements of its fraction field `K`
are also elements of `R`. -/
theorem is_integrally_closed_iff :
  is_integrally_closed R ↔ ∀ {x : K}, is_integral R x → ∃ y, algebra_map R K y = x :=
begin
  let e : K ≃ₐ[R] fraction_ring R := is_localization.alg_equiv R⁰_ _,
  split,
  { rintros ⟨cl⟩,
    refine λ x hx, _,
    obtain ⟨y, hy⟩ := cl ((is_integral_alg_equiv e).mpr hx),
    exact ⟨y, e.algebra_map_eq_apply.mp hy⟩ },
  { rintros cl,
    refine ⟨λ x hx, _⟩,
    obtain ⟨y, hy⟩ := cl ((is_integral_alg_equiv e.symm).mpr hx),
    exact ⟨y, e.symm.algebra_map_eq_apply.mp hy⟩ },
end

/-- `R` is integrally closed iff it is the integral closure of itself in its field of fractions. -/
theorem is_integrally_closed_iff_is_integral_closure :
  is_integrally_closed R ↔ is_integral_closure R R K :=
(is_integrally_closed_iff K).trans $
begin
  let e : K ≃ₐ[R] fraction_ring R := is_localization.alg_equiv R⁰_ _,
  split,
  { intros cl,
    refine ⟨is_fraction_ring.injective _ _, λ x, ⟨cl, _⟩⟩,
    rintros ⟨y, y_eq⟩,
    rw ← y_eq,
    exact is_integral_algebra_map },
  { rintros ⟨-, cl⟩ x hx,
    exact cl.mp hx }
end

end iff

namespace is_integrally_closed

variables {R : Type*} [comm_ring R] [is_domain R] [iic : is_integrally_closed R]
variables {K : Type*} [field K] [algebra R K] [is_fraction_ring R K]

instance : is_integral_closure R R K :=
(is_integrally_closed_iff_is_integral_closure K).mp iic

include iic

lemma is_integral_iff {x : K} : is_integral R x ↔ ∃ y, algebra_map R K y = x :=
is_integral_closure.is_integral_iff

omit iic
variables {R} (K)
lemma integral_closure_eq_bot_iff :
  integral_closure R K = ⊥ ↔ is_integrally_closed R :=
begin
  refine eq_bot_iff.trans _,
  split,
  { rw is_integrally_closed_iff K,
    intros h x hx,
    exact set.mem_range.mp (algebra.mem_bot.mp (h hx)),
    assumption },
  { intros h x hx,
    rw [algebra.mem_bot, set.mem_range],
    exactI is_integral_iff.mp hx },
end

include iic
variables (R K)
@[simp] lemma integral_closure_eq_bot : integral_closure R K = ⊥ :=
(integral_closure_eq_bot_iff K).mpr ‹_›

end is_integrally_closed

namespace integral_closure

open is_integrally_closed

variables {R : Type*} [comm_ring R] [is_domain R] [iic : is_integrally_closed R]
variables (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]
variables {L : Type*} [field L] [algebra K L] [algebra R L] [is_scalar_tower R K L]

-- Can't be an instance because you need to supply `K`.
lemma is_integrally_closed_of_finite_extension [finite_dimensional K L] :
  is_integrally_closed (integral_closure R L) :=
begin
  letI : is_fraction_ring (integral_closure R L) L := is_fraction_ring_of_finite_extension K L,
  exact (integral_closure_eq_bot_iff L).mp integral_closure_idem
end

end integral_closure


-- Pruebas de ¬∀x P(x) ↔ ∃x ¬P(x)
-- ==============================

import tactic

variable {U : Type}
variable {P : U -> Prop}

-- ----------------------------------------------------
-- Ej. 1. Demostrar que
--    ¬∀x P(x) ⊢ ∃x ¬P(x)
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra
            ( assume h4 : ¬P a,
              have h5 : ∃x, ¬P x,
                from exists.intro a h4,
              show false, from h2 h5 )),
    show false, from h1 h8)

-- 2ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra
            ( assume h4 : ¬P a,
              have h5 : ∃x, ¬P x,
                from exists.intro a h4,
              show false, from h2 h5 )),
    h1 h8)

-- 3ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra
            ( assume h4 : ¬P a,
              have h5 : ∃x, ¬P x,
                from exists.intro a h4,
              h2 h5 )),
    h1 h8)

-- 4ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra
            ( assume h4 : ¬P a,
              have h5 : ∃x, ¬P x, from ⟨a, h4⟩,
              h2 h5 )),
    h1 h8)

-- 5ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra
            ( assume h4 : ¬P a,
              h2 ⟨a, h4⟩ )),
    h1 h8)

-- 6ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        show P a, from
          by_contra (λ h4, h2 ⟨a, h4⟩)),
    h1 h8)

-- 7ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      ( assume a,
        by_contra (λ h4, h2 ⟨a, h4⟩)),
    h1 h8)

-- 8ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    have h8 : ∀x, P x, from
      (λ a, by_contra (λ h4, h2 ⟨a, h4⟩)),
    h1 h8)

-- 9ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra
  ( assume h2 : ¬∃x, ¬P x,
    h1 (λ a, by_contra (λ h4, h2 ⟨a, h4⟩)))

-- 10ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
by_contra (λ h2, h1 (λ a, by_contra (λ h4, h2 ⟨a, h4⟩)))

-- 11ª demostración
example
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
-- by library_search
not_forall.mp h1

-- 12ª demostración
lemma aux1
  (h1 : ¬∀x, P x)
  : ∃x, ¬P x :=
-- by hint
by finish

-- ----------------------------------------------------
-- Ej. 2. Demostrar que
--    ∃x ¬P(x) ⊢ ¬∀x P(x)
-- ----------------------------------------------------

-- 1ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume a (h3 : ¬P a),
    have h4 : P a, from h2 a,
    show false, from h3 h4)

-- 2ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume a (h3 : ¬P a),
    have h4 : P a, from h2 a,
    h3 h4)

-- 3ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  ( assume a (h3 : ¬P a),
    h3 (h2 a))

-- 4ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
exists.elim h1
  (λ a h3, h3 (h2 a))

-- 5ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
λ h2, exists.elim h1 (λ a h3, h3 (h2 a))

-- 6ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
-- by library_search
not_forall.mpr h1

-- 7ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
assume h2 : ∀x, P x,
match h1 with ⟨a, (h3 : ¬P a)⟩ :=
  ( have h4 : P a, from h2 a,
    show false,     from h3 h4)
end

-- 8ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
begin
  intro h2,
  cases h1 with a h3,
  apply h3,
  apply h2,
end

example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
begin
  intro h2,
  obtain ⟨a, h3⟩ := h1,
  apply h3,
  apply h2,
end

-- 9ª demostración
example
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
-- by hint
by tauto

-- 10ª demostración
lemma aux2
  (h1 : ∃x, ¬P x)
  : ¬∀x, P x :=
by finish

#print axioms aux2

-- ----------------------------------------------------
-- Ej. 3. Demostrar que
--    ¬∀x P(x) ↔ ∃x ¬P(x)
-- ----------------------------------------------------

-- 1ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
iff.intro
  ( assume h1 : ¬∀x, P x,
    show ∃x, ¬P x, from aux1 h1)
  ( assume h2 : ∃x, ¬P x,
    show ¬∀x, P x, from aux2 h2)

-- 2ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
iff.intro aux1 aux2

-- 3ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
-- by library_search
not_forall

-- 4ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
begin
  split,
  { exact aux1, },
  { exact aux2, },
end

-- 5ª demostración
example :
  (¬∀x, P x) ↔ (∃x, ¬P x) :=
-- by hint
by finish


import .love06_monads_demo

/-! # LoVe Exercise 6: Monads -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: A State Monad with Failure

We introduce a richer notion of lawful monad that provides an `orelse`
operator `<|>` satisfying some laws, given below. `emp` denotes failure.
`x <|> y` tries `x` first, falling back on `y` on failure. -/

@[class] structure lawful_monad_with_orelse (m : Type → Type)
  extends lawful_monad m, has_orelse m : Type 1 :=
(emp {α : Type} : m α)
(emp_orelse {α : Type} (a : m α) :
  (emp <|> a) = a)
(orelse_emp {α : Type} (a : m α) :
  (a <|> emp) = a)
(orelse_assoc {α : Type} (a b c : m α) :
  ((a <|> b) <|> c) = (a <|> (b <|> c)))
(emp_bind {α β : Type} (f : α → m β) :
  (emp >>= f) = emp)
(bind_emp {α β : Type} (f : m α) :
  (f >>= (λa, emp : α → m β)) = emp)

/-! 1.1. We set up the `option` type constructor to be a
`lawful_monad_with_orelse`. Complete the proofs.

Hint: Use `simp [(>>=)]` to unfold the definition of the bind operator and
`simp [(<|>)]` to unfold the definition of the `orelse` operator. -/

def option.orelse {α : Type} : option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def lawful_monad_with_orelse_option :
  lawful_monad_with_orelse option :=
{ emp          := λα, option.none,
  orelse       := @option.orelse,
  emp_orelse   :=
    begin
      intros α a,
      simp [(<|>)],
      refl
    end,
  orelse_emp   :=
    begin
      intros α a,
      simp [(<|>)],
      cases' a,
      { refl },
      { refl }
    end,
  orelse_assoc :=
    begin
      intros α a b c,
      simp [(<|>)],
      cases' a,
      { refl },
      { refl }
    end,
  emp_bind     :=
    begin
      intros α β f,
      simp [(>>=)],
      refl
    end,
  bind_emp     :=
    begin
      intros α β g,
      simp [(>>=)],
      cases' g,
      { refl },
      { refl }
    end,
  .. option.lawful_monad }

@[simp] lemma option.some_bind {α β : Type} (a : α) (g : α → option β) :
  (option.some a >>= g) = g a :=
by refl

/-! Let us enable some convenient pattern matching syntax, by instantiating
Lean's `monad_fail` type class. (Do not worry if you do not understand what
we are referring to.) -/

@[instance] def lawful_monad_with_orelse.monad_fail {m : Type → Type}
  [lawful_monad_with_orelse m] : monad_fail m :=
{ fail := λα msg, lawful_monad_with_orelse.emp }

/-! Now we can write definitions such as the following: -/

def first_of_three {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  [n, _, _] ← c,
  pure n

#eval first_of_three (option.some [1])
#eval first_of_three (option.some [1, 2, 3])
#eval first_of_three (option.some [1, 2, 3, 4])

/-! Using `lawful_monad_with_orelse` and the `monad_fail` syntax, we can give a
concise definition for the `sum_2_5_7` function seen in the lecture. -/

def sum_2_5_7₇ {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  (_ :: n2 :: _ :: _ :: n5 :: _ :: n7 :: _) ← c,
  pure (n2 + n5 + n7)

/-! 1.2. Now we are ready to define `faction σ` ("eff action"): a monad with an
internal state of type `σ` that can fail (unlike `action σ`).

We start with defining `faction σ α`, where `σ` is the type of the internal
state, and `α` is the type of the value stored in the monad. We use `option` to
model failure. This means we can also use the monad operations of `option` when
defining the monad operations on `faction`.

Hints:

* Remember that `faction σ α` is an alias for a function type, so you can use
  pattern matching and `λs, …` to define values of type `faction σ α`.

* `faction` is very similar to `action` from the lecture's demo. You can look
  there for inspiration. -/

def faction (σ : Type) (α : Type) : Type :=
σ → option (α × σ)

/-! 1.3. Define the `get` and `set` function for `faction`, where `get` returns
the state passed along the state monad and `set s` changes the state to `s`. -/

def get {σ : Type} : faction σ σ
| s := option.some (s, s)

def set {σ : Type} (s : σ) : faction σ unit
| _ := option.some ((), s)

/-! We set up the `>>=` syntax on `faction`: -/

def faction.bind {σ α β : Type} (f : faction σ α) (g : α → faction σ β) :
  faction σ β
| s := f s >>= (λas, g (prod.fst as) (prod.snd as))

@[instance] def faction.has_bind {σ : Type} : has_bind (faction σ) :=
{ bind := @faction.bind σ }

lemma faction.bind_apply {σ α β : Type} (f : faction σ α) (g : α → faction σ β)
    (s : σ) :
  (f >>= g) s = (f s >>= (λas, g (prod.fst as) (prod.snd as))) :=
by refl

/-! 1.4. Define the operator `pure` for `faction`, in such a way that it will
satisfy the three laws. -/

def faction.pure {σ α : Type} (a : α) : faction σ α
| s := option.some (a, s)

/-! We set up the syntax for `pure` on `faction`: -/

@[instance] def faction.has_pure {σ : Type} : has_pure (faction σ) :=
{ pure := @faction.pure σ }

lemma faction.pure_apply {σ α : Type} (a : α) (s : σ) :
  (pure a : faction σ α) s = option.some (a, s) :=
by refl

/-! 1.3. Register `faction` as a monad.

Warning: The last goal is difficult.

Hints:

* The `funext` lemma is useful when you need to prove equality between two
  functions.

* `cases' f s` only works when `f s` appears in your goal, so you may need to
  unfold some constants before you can invoke `cases'`.

* The lemma `faction.pure_apply` or `faction.bind_apply` might prove useful. -/

@[instance] def faction.lawful_monad {σ : Type} : lawful_monad (faction σ) :=
{ pure_bind  :=
    begin
      intros α β a f,
      simp [pure, bind],
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    begin
      intros α ma,
      apply funext,
      intro s,
      simp [faction.bind_apply, faction.pure_apply],
      apply lawful_monad.bind_pure
    end,
  bind_assoc :=
    begin
      intros α β γ f g ma,
      apply funext,
      intro s,
      simp [faction.bind_apply],
      cases' ma s,
      { refl },
      { cases' val,
        refl }
    end,
  ..faction.has_bind,
  ..faction.has_pure }

/-! ## Question 2: Kleisli Operator

The Kleisli operator `>=>` (not to be confused with `>>=`) is useful for
pipelining effectful functions. Note that `λa, f a >>= g` is to be parsed as
`λa, (f a >>= g)`, not as `(λa, f a) >>= g`. -/

def kleisli {m : Type → Type} [lawful_monad m] {α β γ : Type} (f : α → m β)
  (g : β → m γ) : α → m γ :=
λa, f a >>= g

infixr ` >=> ` : 90 := kleisli

/-! 2.1. Prove that `pure` is a left and right unit for the Kleisli operator. -/

lemma pure_kleisli {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (pure >=> f) = f :=
begin
  apply funext,
  intro a,
  exact lawful_monad.pure_bind a f
end

lemma kleisli_pure {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (f >=> pure) = f :=
begin
  apply funext,
  intro a,
  exact lawful_monad.bind_pure (f a)
end

/-! 2.2. Prove that the Kleisli operator is associative. -/

lemma kleisli_assoc {m : Type → Type} [lawful_monad m] {α β γ δ : Type}
    (f : α → m β) (g : β → m γ) (h : γ → m δ) :
  ((f >=> g) >=> h) = (f >=> (g >=> h)) :=
begin
  apply funext,
  intro a,
  exact lawful_monad.bind_assoc g h (f a)
end

end LoVe


import multiset data.fintype.basic linear_algebra.dimension
  set_pi arithmetic measure_theory.measure.measure_space_def
  data.multiset
  linear_algebra.finite_dimensional
  analysis.inner_product_space.projection
  analysis.inner_product_space.dual
  data.multiset.basic
  data.nat.basic

open_locale pointwise

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

variables {V: Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]

instance submodule.complete_space (E : submodule ℝ V) : complete_space E :=
is_complete.complete_space_coe (submodule.complete_of_finite_dimensional E)

noncomputable def vector_orth (u : V) : submodule ℝ V :=
(submodule.span ℝ ({u} : set V))ᗮ

lemma mem_vector_orth {u : V} {x : V} :
x ∈ vector_orth u ↔ ⟪x, u⟫_ℝ = 0 :=
begin
  simp only [vector_orth, submodule.mem_orthogonal, submodule.mem_span_singleton],
  split,
  {
    intro h,
    rw [real_inner_comm],
    refine h u _,
    exact ⟨1, one_smul _ _⟩,
  },
  {
    rintro h u ⟨a, rfl⟩,
    simp only [inner_smul_left, is_R_or_C.conj_to_real, mul_eq_zero],
    right, rw [real_inner_comm], exact h,
  }
end

noncomputable abbreviation dim := finite_dimensional.finrank ℝ
abbreviation diff (A : set V) := A -ᵥ A

noncomputable def common_dimension
  (C : multiset (set V)) : ℕ :=
  finite_dimensional.finrank ℝ (vector_span ℝ C.sum)

lemma mem_of_mem_of_generator
  {A : set V} {x : V} (h : x ∈ A) : x ∈ submodule.span ℝ A :=
begin
  refine (set.mem_of_mem_of_subset h _ : x ∈ ↑(submodule.span ℝ A)),
  apply submodule.subset_span,
end

lemma vector_span_zero
  (A : set V) (h : (0 : V) ∈ A) : vector_span ℝ A = submodule.span ℝ A :=
begin
  simp only [vector_span],
  apply submodule.complete_lattice.le_antisymm,
  begin
    refine submodule.span_le.mpr (_ : A -ᵥ A ⊆ ↑(submodule.span ℝ A)),
    rw [set.subset_def],
    intros x hmem,
    rcases set.mem_sub.mp hmem with ⟨a, b, ⟨ha, hb, rfl⟩⟩,
    refine (submodule.sub_mem _ _ _ : a - b ∈ submodule.span ℝ A),
    exact  mem_of_mem_of_generator ha,
    exact mem_of_mem_of_generator hb,
  end,
  begin
    apply submodule.span_mono,
    simp only [has_subset.subset, has_le.le],
    intros x x_in_A,
    refine set.mem_sub.mpr ⟨x, 0, _⟩,
    simp [h, x_in_A],
  end
end

lemma exists_zero_translate
  (A : set V) : ∃ x : V, A + {x} = ∅ ∨ (0 : V) ∈ (A + {x}) :=
begin
  by_cases A = ∅,
  begin
    rcases h with rfl,
    simp,
  end,
  begin
    have := set.ne_empty_iff_nonempty.mp h,
    rcases set.nonempty_def.mp this with ⟨y, hy⟩,
    refine ⟨-y, or.inr _⟩,
    rw [show 0 = y + (-y), by simp],
    apply set.mem_add.mpr,
    tauto,
  end
end

lemma submodule_sum_eq_sup
  (E F : submodule ℝ V) : E + F = E ⊔ F := rfl

lemma zero_subset_submodule (E : submodule ℝ V) : {(0 : V)} ⊆ (E : set V) :=
begin
  simp,
end

lemma set_add_zero (A : set V) : A + {(0 : V)} = A :=
begin
  simp,
end

lemma set_add_le_add_right (A B C : set V) (h : B ⊆ C) : A + B ⊆ A + C :=
begin
  rintro x ⟨a, b, ⟨ha, hb, rfl⟩⟩,
  refine ⟨a, b, _⟩, -- exists.intro; interesting that it works
  tauto,
end

lemma set_add_le_add_left (A B C : set V) (h : A ⊆ B) : A + C ⊆ B + C :=
begin
  rintro x ⟨a, b, ⟨ha, hb, rfl⟩⟩,
  refine ⟨a, b, _⟩, -- exists.intro; interesting that it works
  tauto,
end

lemma set_le_add_right (E F : set V) (h : (0: V) ∈ F) : E ⊆ E + F :=
begin
  conv {to_lhs, rw [←@set_add_zero V _ _ E]},
  apply_rules [set_add_le_add_right, set.singleton_subset_iff.mpr h],
end

lemma set_le_add_left (E F : set V) (h : (0: V) ∈ F) : E ⊆ F + E :=
begin
  rw [add_comm],
  exact set_le_add_right E F h,
end

lemma submodule_sum_eq_mink_sum
  {E F : submodule ℝ V} : ((E + F : submodule ℝ V) : set V) = (E : set V) + (F : set V) :=
begin
  have E_le : E ≤ E + F := by simp,
  have F_le : F ≤ E + F := by simp,
  apply le_antisymm,
  begin
    let G := submodule.span ℝ ((E : set V) + (F : set V)),
    have inG : E + F ≤ G :=
    begin
      have : Π(H K : submodule ℝ V), (H : set V) ⊆ (H : set V) + (K : set V) :=
      begin
        intros H K,
        conv {
          to_lhs,
          rw [←@set_add_zero V _ _ H],
        },
        apply_rules [set_add_le_add_right, zero_subset_submodule],
      end,
      begin
        refine complete_lattice.sup_le E F G _ _,
        begin
          rw [←submodule.span_eq E],
          apply submodule.span_mono,
          refine set_le_add_right E F _,
          apply submodule.zero_mem,
        end,
        begin
          rw [←submodule.span_eq F],
          apply submodule.span_mono,
          refine set_le_add_left F E _,
          apply submodule.zero_mem,
        end
      end
    end,
    have G_EF : (G : set V) ≤ (E : set V) + (F : set V) :=
    begin
      intros x hx,
      refine submodule.span_induction hx _ _ _ _,
      begin
        tauto,
      end,
      begin
        refine ⟨0, 0, ⟨_, _, _⟩⟩,
        apply submodule.zero_mem,
        apply submodule.zero_mem,
        simp,
      end,
      begin
        rintro x y ⟨ex, fx, ⟨hex, hfx, rfl⟩⟩ ⟨ey, fy, ⟨hey, hfy, rfl⟩⟩,
        refine ⟨ex + ey, fx + fy, _, _, _⟩,
        apply submodule.add_mem E hex hey,
        apply submodule.add_mem F hfx hfy,
        abel,
      end,
      begin
        rintro a x ⟨e, f, ⟨he, hf, rfl⟩⟩,
        refine ⟨a • e, a • f, _, _, _⟩,
        apply submodule.smul_mem E a he,
        apply submodule.smul_mem F a hf,
        simp,
      end
    end,
    refine le_trans inG G_EF,
  end,
  begin
    rintro x ⟨e, f, he, hf, rfl⟩,
    refine submodule.add_mem (E + F) _ _,
    exact E_le he,
    exact F_le hf,
  end
end

lemma add_subset_submodule
  {A B : set V} {E : submodule ℝ V} (hA : A ⊆ E) (hB : B ⊆ E): A + B ⊆ E :=
begin
  intros s hs,
  rcases set.mem_add.mp hs with ⟨a, b, ⟨ha, hb, rfl⟩⟩,
  apply submodule.add_mem,
  exact @set.mem_of_mem_of_subset _ _ _ _ ha hA,
  exact @set.mem_of_mem_of_subset _ _ _ _ hb hB,
end

lemma submodule_subset_of_le
  {E F : submodule ℝ V} : E ≤ F = ((E : set V) ⊆ (F : set V)) :=
begin
  apply propext,
  apply iff.intro,
  all_goals {
    intros h e he,
    exact h he,
  }
end

lemma set_ABAB_AABB
  {A B : set V} : (A + B) - (A + B) = (A - A) + (B - B) :=
begin
  apply le_antisymm,
  all_goals {
    rintro _ ⟨_, _, ⟨a, b, ha, hb, rfl⟩, ⟨c, d, hc, hd, rfl⟩, rfl⟩,
  },
  begin
    refine ⟨a - c, b - d, ⟨a, c, _, _, rfl⟩, ⟨b, d, _, _, rfl⟩, _⟩,
    any_goals {assumption},
    abel,
  end,
  begin
    refine ⟨a + c, b + d, ⟨a, c, _, _, rfl⟩, ⟨b, d, _, _, rfl⟩, _⟩,
    any_goals {assumption},
    abel,
  end
end

lemma zero_mem_diff_of_nonempty
  {A : set V} (ne : A.nonempty) : (0 : V) ∈ A - A :=
begin
  letI ne' := set.nonempty.to_subtype ne,
  rcases set.exists_mem_of_nonempty A with ⟨⟨x, hx⟩, -⟩,
  rw [show (0 : V) = x - x, by simp],
  refine set.sub_mem_sub _ _,
  all_goals {assumption},
end

lemma nonempty_sets_of_nonempty_sum {A B : set V}
(h : set.nonempty (A + B)) : set.nonempty A ∧ set.nonempty B :=
begin
  rcases h with ⟨x, ⟨a, b, ha, hb, rfl⟩⟩,
  exact ⟨⟨a, ha⟩, ⟨b, hb⟩⟩,
end

lemma multiset_sum_nonempty_of_elements {A : multiset (set V)}
(h : ∀ a : set V, a ∈ A → a.nonempty): A.sum.nonempty :=
begin
  unfreezingI {
    induction A using pauls_multiset_induction with as b ih,
    {
      simp [set.zero_nonempty],
    },
    {
      simp only [multiset.sum_cons],
      apply set.add_nonempty.mpr,
      split,
      {
        refine h b _,
        simp,
      },
      {
        apply ih,
        intros c hc,
        refine h c _,
        simp [hc],
      }
    }
  }
end

lemma diff_set_le_add (A B : set V) (Bne : set.nonempty B) :
diff A ⊆ diff (B + A) :=
begin
  rcases Bne with ⟨b, hb⟩,
  rintro d ⟨a, a', ha, ha', rfl⟩,
  refine ⟨b + a, b + a', ⟨b, a, _⟩, ⟨b, a', _⟩, _⟩,
  any_goals {simp},
  all_goals {tauto},
end

def multiset_all_nonempty (F : multiset (set V))
:= ∀ x ∈ F, set.nonempty x

lemma all_nonempty_of_le {F G : multiset (set V)}
(h : F ≤ G) : multiset_all_nonempty G → multiset_all_nonempty F :=
begin
  intros neG x hx,
  refine neG x _,
  exact multiset.mem_of_le h hx,
end

lemma diff_multiset_sum_mono {F G : multiset (set V)}
(h : F ≤ G) (hne : ∀ x ∈ G, set.nonempty x) :
diff F.sum ⊆ diff G.sum :=
begin
  rcases multiset.le_iff_exists_add.mp h with ⟨E, rfl⟩,
  simp only [multiset.sum_add],
  rw [add_comm],
  refine diff_set_le_add F.sum E.sum _,
  refine multiset_sum_nonempty_of_elements _,
  intros a ha,
  refine hne a _,
  apply multiset.mem_add.mpr,
  tauto,
end

-- I almost forgot that the sets must not be empty...
lemma vector_span_sum_commute
  (A B : set V) (Ane : A.nonempty) (Bne : B.nonempty) : vector_span ℝ (A + B) = (vector_span ℝ A) + (vector_span ℝ B) :=
begin
  apply submodule.complete_lattice.le_antisymm,
  begin
    simp only [vector_span],
    refine submodule.span_le.mpr _,
    rintros x ⟨ab1, ab2,
      ⟨⟨a1, b1, ⟨ha1, hb1, rfl⟩⟩, ⟨a2, b2, ⟨ha2, hb2, rfl⟩⟩, rfl⟩⟩,
      have : a1 + b1 - (a2 + b2) = a1 - a2 + (b1 - b2) := by abel,
      simp only [has_vsub.vsub, this],
      rw [submodule_sum_eq_mink_sum],
      apply set.add_mem_add,
      begin
        refine submodule.subset_span _,
        refine ⟨a1, a2, ha1, ha2, rfl⟩,
      end,
      begin
        refine submodule.subset_span _,
        refine ⟨b1, b2, hb1, hb2, rfl⟩,
      end
  end,
  begin
    simp only [submodule_subset_of_le, submodule_sum_eq_mink_sum],
    rintro x ⟨a, b, ha, hb, rfl⟩,
    change a + b ∈ vector_span ℝ (A + B),
    simp only [vector_span] at *,
    simp only [set_vsub_eq_sub] at *,
    simp only [set_ABAB_AABB],
    refine submodule.add_mem _ _ _,
    all_goals {refine submodule.span_mono _ (by assumption)}, --wow, it works!
    begin
      refine set_le_add_right _ _ _,
      exact zero_mem_diff_of_nonempty Bne,
    end,
    begin
      refine set_le_add_left _ _ _,
      exact zero_mem_diff_of_nonempty Ane,
    end
  end
end

def semicritical (C : multiset (set V)) :=
  ∀ τ : multiset (set V), τ ≤ C → common_dimension τ ≥ τ.card

def project_set (E : submodule ℝ V): set V → set E :=
λ A, orthogonal_projection E '' A

def project_collection (E : submodule ℝ V) (C : multiset (set V)) :
multiset (set E) :=
C.map (project_set E)

lemma minksum_proj_commute (E : submodule ℝ V) (A B : set V) :
project_set E (A + B) = project_set E A + project_set E B :=
begin
  apply set.ext,
  intro x,
  simp only [project_set, set.mem_add, set.mem_image] at *,
  apply iff.intro,
  begin
    intro h,
    rcases h with ⟨-, ⟨⟨a, b, ⟨ha, hb, rfl⟩⟩, rfl⟩⟩,
    rw [continuous_linear_map.map_add],
    tauto,
  end,
  begin
    intro h,
    rcases h with ⟨pa, pb, ⟨⟨a, ⟨ha, rfl⟩⟩, ⟨b, ⟨hb, rfl⟩⟩, rfl⟩⟩,
    rw [←continuous_linear_map.map_add],
    tauto,
  end
end

lemma minksum_proj_commute_list (E : submodule ℝ V) (C : list (set V)) :
project_set E C.sum = (C.map $ project_set E).sum :=
begin
  induction C,
  begin
    simp [project_set],
    trivial,
  end,
  begin
    simp [←C_ih, minksum_proj_commute],
  end,
end

lemma minksum_proj_commute_multiset (E : submodule ℝ V) (C : multiset (set V)) :
project_set E C.sum = (project_collection E C).sum :=
begin
  induction C,
  begin
    simp only [multiset.quot_mk_to_coe'', project_collection, multiset.coe_map, multiset.coe_sum],
    apply minksum_proj_commute_list,
  end,
  trivial,
end

lemma subcollection_semicritical {C D: multiset (set V)} (hDC : D ≤ C) (hsc : semicritical C) :
semicritical D :=
begin
  intro S,
  intro hSD,
  apply hsc,
  apply le_trans hSD hDC,
end

def cart_prod {V W : Type} (A : set V) (B : set W) : set (V × W) :=
{ x : V × W | x.fst ∈ A ∧ x.snd ∈ B }

lemma set_image2_eq_image_times {V W : Type} {A B : set V}
{f : V → V → W} : set.image2 f A B = set.image (function.uncurry f) (cart_prod A B) :=
begin
  simp [set.image2, set.image, function.uncurry, cart_prod],
  apply le_antisymm,
  {
    rintro _ ⟨a, ⟨ha, b, hb, h⟩⟩,
    refine ⟨a, b, ⟨ha, hb⟩, h⟩,
  },
  {
    rintro _ ⟨a, b, ⟨ha, hb⟩, h⟩,
    exact ⟨a, ha, b, hb, h⟩,
  }
end

lemma set_sum_project_commute (A B : set V) (E : submodule ℝ V) :
project_set E (A + B) = (project_set E A) + (project_set E B) :=
begin
  simp only [project_set],
  apply le_antisymm,
  {
    rintro e ⟨x, ⟨⟨a, b, ha, hb, rfl⟩, rfl⟩⟩,
    rw [(orthogonal_projection E).map_add],
    apply set.add_mem_add,
    {
      refine ⟨a, _⟩,
      tauto,
    },
    {
      refine ⟨b, _⟩,
      tauto,
    }
  },
  {
    rintro e ⟨pa, pb, ⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩, rfl⟩,
    rw [←(orthogonal_projection E).map_add],
    refine ⟨a+b, _⟩,
    split,
    any_goals {refl},
    apply set.add_mem_add,
    all_goals {assumption},
  }
end

-- maybe generalizable to the situation when add commutes with any f
lemma multiset_sum_project_set_commute (C : multiset (set V)) (E : submodule ℝ V) :
project_set E C.sum = (C.map (project_set E)).sum :=
begin
  induction C using pauls_multiset_induction with C c ih,
  {
    simp only [project_set, multiset.sum_zero, set.image_zero, map_zero, multiset.map_zero],
    trivial,
  },
  {
    simp only [multiset.sum_cons, set_sum_project_commute],
    simp only [multiset.map_cons, multiset.sum_cons],
    rw [ih],
  }
end

noncomputable def proj (E : submodule ℝ V) := (orthogonal_projection E).to_linear_map

lemma ker_of_orthogonal_projection (E : submodule ℝ V) : (proj E).ker = Eᗮ :=
begin
  apply le_antisymm,
  {
    rintro x hx,
    have hx' : orthogonal_projection E x = 0 := hx,
    rw [show x = x - orthogonal_projection E x, by simp [hx']],
    apply sub_orthogonal_projection_mem_orthogonal,
  },
  {
    rintro x hx,
    refine orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero hx,
  }
end

lemma ker_of_complementary_orthogonal_projection (E : submodule ℝ V) : (proj Eᗮ).ker = E :=
begin
  conv {to_rhs, rw [←submodule.orthogonal_orthogonal E]},
  apply ker_of_orthogonal_projection,
end

lemma surjective_orthogonal_projection (E : submodule ℝ V): function.surjective (proj E) :=
begin
  rintro e,
  refine ⟨e, _⟩,
  simp only [proj, continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe,
  orthogonal_projection_mem_subspace_eq_self],
end

lemma range_of_orthogonal_projection (E : submodule ℝ V): (proj E).range = ⊤ :=
begin
  apply linear_map.range_eq_top.mpr,
  simp only [proj, continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe],
  apply surjective_orthogonal_projection,
end

lemma dim_add_dim_orthogonal (E : submodule ℝ V) :
dim E + dim Eᗮ = dim V :=
begin
  have : dim E = dim (⊤ : submodule ℝ E) := finrank_top.symm,
  rw [←ker_of_orthogonal_projection E, this, ←range_of_orthogonal_projection E],
  apply linear_map.finrank_range_add_finrank_ker,
end

def submodule_inclusion (W : submodule ℝ V) : W →ₗ[ℝ] V :=
begin
  refine ⟨_, _, _⟩,
  exact (coe : W → V),
  tauto,
  tauto,
end

lemma submodule_inclusion_injective {W : submodule ℝ V} : function.injective (submodule_inclusion W) :=
begin
  rintro x y,
  simp [submodule_inclusion],
end

def submodule_to_submodule_inclusion {S T : submodule ℝ V} (h : S ≤ T)
: S →ₗ[ℝ] T :=
begin
  refine ⟨_, _, _⟩,
  {
    rintro x,
    exact ⟨x.1, h x.2⟩,
  },
  {tauto},
  {tauto},
end

def submodule_to_submodule_inclusion_injective {S T : submodule ℝ V} (h : S ≤ T)
: function.injective (submodule_to_submodule_inclusion h) :=
begin
  intros x y,
  simp [submodule_to_submodule_inclusion],
end

noncomputable def submodule_submodule_to_submodule {W : submodule ℝ V} (U : submodule ℝ W) :
submodule ℝ V := submodule.span ℝ ((coe : W → V) '' U)

lemma submod_submod_eq_submod_set {W : submodule ℝ V} (U : submodule ℝ W) :
(submodule_submodule_to_submodule U : set V) = ((coe : W → V) '' U) :=
begin
  apply le_antisymm,
  {
    rintro x hx,
    refine submodule.span_induction hx _ _ _ _,
    {
      tauto,
    },
    {
      simp only [set.mem_image, set_like.mem_coe, submodule.coe_eq_zero, exists_eq_right, submodule.zero_mem],
    },
    {
      rintro y z ⟨py, hyU, rfl⟩ ⟨pz, hzU, rfl⟩,
      refine ⟨py + pz, _⟩,
      split,
      {
        apply submodule.add_mem _ hyU hzU,
      },
      simp only [submodule.coe_add],
    },
    {
      rintro a y ⟨py, pyU, rfl⟩,
      refine ⟨a • py, _⟩,
      split,
      {
        apply submodule.smul_mem _ a pyU,
      },
      simp only [submodule.coe_smul_of_tower],
    },
  },
  {
    apply submodule.subset_span,
  }
end

def submodule_submodule_mapsto_submodule {W : submodule ℝ V} (U : submodule ℝ W) :
U →ₗ[ℝ] submodule_submodule_to_submodule U :=
begin
  refine ⟨_, _, _⟩,
  {
    rintro v,
    refine ⟨v.1.1, _⟩,
    simp only [submodule_submodule_to_submodule],
    refine submodule.subset_span _,
    refine ⟨v.1, _⟩,
    simp,
  },
  {
    tauto,
  },
  {
    tauto,
  },
end

lemma sub_inequality_from_add_inequality
{a b c : ℕ} : a + b ≥ c → a ≥ c - b :=
begin
  exact tsub_le_iff_right.mpr,
end

lemma image_eq_range_dom_restrict
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
  W.map f = (f.dom_restrict W).range :=
begin
  apply le_antisymm,
  {
    rintro y ⟨x, ⟨hx, rfl⟩⟩,
    rw [show f x = f.dom_restrict W ⟨x, hx⟩, by refl],
    apply linear_map.mem_range_self,
  },
  {
    rintro y ⟨⟨x, hx⟩, rfl⟩,
    rw [show f.dom_restrict W ⟨x, hx⟩ = f x, by refl],
    apply submodule.mem_map_of_mem hx,
  }
end

lemma map_ker_restrict
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
(f.dom_restrict W).ker.map W.subtype = f.ker ⊓ W :=
begin
  unfold linear_map.dom_restrict,
  rw [linear_map.ker_comp],
  apply le_antisymm,
  {
    refine le_inf _ _,
    {apply submodule.map_comap_le},
    {
      conv {to_rhs, rw [←submodule.range_subtype W]},
      apply linear_map.map_le_range,
    }
  },
  {
    rintro x ⟨hxf, hxW⟩,
    refine ⟨⟨x, hxW⟩, _⟩,
    simp only [hxf, submodule.comap_coe, submodule.coe_subtype, set.mem_preimage, submodule.coe_mk, eq_self_iff_true, and_self],
  }
end

def ker_restrict_equiv
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
(f.dom_restrict W).ker ≃ₗ[K] (f.ker ⊓ W : submodule K V) :=
begin
  rw [←map_ker_restrict],
  apply submodule.equiv_subtype_map,
end

def ker_dom_restrict_inclusion
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
  (f.dom_restrict W).ker →ₗ[K] f.ker :=
begin
  let g := W.subtype,
  let h := (f.dom_restrict W).ker.subtype,
  let k := g ∘ₗ h,
  refine k.cod_restrict f.ker _,
  rintro ⟨c, hc⟩,
  exact hc,
end

def ker_dom_restrict_inclusion_injective
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
function.injective (ker_dom_restrict_inclusion f W) :=
begin
  have : function.injective (coe : f.ker → V) := subtype.coe_injective,
  rintro x y,
  unfold ker_dom_restrict_inclusion,
  simp only, -- remove let
  intro h,
  replace h := congr_arg (coe : f.ker → V) h,
  simp only [linear_map.cod_restrict_apply, linear_map.comp_apply] at h,
  simp only [submodule.coe_subtype] at h,
  exact subtype.coe_injective (subtype.coe_injective h),
end

lemma subspace_rank_nullity
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
finite_dimensional.finrank K (W.map f) + finite_dimensional.finrank K (f.ker ⊓ W : submodule K V)
= finite_dimensional.finrank K W :=
begin
  let g := f.dom_restrict W,
  rw [image_eq_range_dom_restrict],
  have := ker_restrict_equiv f W,
  rw [←linear_equiv.finrank_eq this],
  apply linear_map.finrank_range_add_finrank_ker g,
end

lemma dim_image_le_self
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
finite_dimensional.finrank K (W.map f) ≤ finite_dimensional.finrank K W :=
begin
  rw [←subspace_rank_nullity f W],
  simp only [le_add_iff_nonneg_right, zero_le'],
end

lemma dim_image_ge_dim_domain_sub_dim_ker
  {K : Type} {V : Type} [field K] [add_comm_group V] [module K V]
  {V₂ : Type} [add_comm_group V₂] [module K V₂] [finite_dimensional K V]
  (f : V →ₗ[K] V₂) (W : submodule K V) :
  finite_dimensional.finrank K (W.map f) ≥ finite_dimensional.finrank K W - finite_dimensional.finrank K f.ker :=
begin
  let g := f.dom_restrict W,
  have hrange : W.map f = g.range := image_eq_range_dom_restrict f W,
  have hker : finite_dimensional.finrank K g.ker ≤ finite_dimensional.finrank K f.ker :=
  begin
    let incl : g.ker →ₗ[K] f.ker := ker_dom_restrict_inclusion f W,
    have incl_inj : function.injective incl := ker_dom_restrict_inclusion_injective f W,
    apply linear_map.finrank_le_finrank_of_injective incl_inj,
  end,
  have rn := linear_map.finrank_range_add_finrank_ker g,
  rw [←hrange] at rn,
  apply tsub_le_iff_right.mpr,
  rw [←rn],
  refine add_le_add (le_refl _) _,
  assumption,
  apply_instance,
end

noncomputable def project_subspace (E F : submodule ℝ V) : submodule ℝ E :=
F.map (orthogonal_projection E).to_linear_map

@[simp]
lemma multiset.sum_project_subspace
(E : submodule ℝ V)
(C : multiset (submodule ℝ V)) :
project_subspace E C.sum = (C.map (project_subspace E)).sum :=
begin
  apply C.sum_linear_map,
  apply_instance,
end

lemma map_vector_span {R : Type} {M : Type} {M₂ : Type} [field R]
[add_comm_group M] [module R M] {σ₁₂ : R →+* R} [add_comm_group M₂]
[module R M₂] [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M)
: submodule.map f (vector_span R s) = vector_span R (f '' s) :=
begin
  simp only [vector_span],
  simp only [submodule.map_span],
  congr,
  apply le_antisymm,
  {
    rintro x ⟨d, ⟨a, b, ha, hb, rfl⟩, rfl⟩,
    refine ⟨f a, f b, _⟩,
    refine ⟨⟨a, ⟨ha, rfl⟩⟩, ⟨b, ⟨hb, rfl⟩⟩, _⟩,
    simp only [linear_map.map_sub, vsub_eq_sub],
  },
  {
    rintro x ⟨fa, fb, ⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩, rfl⟩,
    refine ⟨a - b, _⟩,
    split,
    {
      refine ⟨a, b, ha, hb, rfl⟩,
    },
    simp only [linear_map.map_sub],
    refl,
  },
end

lemma project_subspace_vector_span {A : set V} {E : submodule ℝ V} :
project_subspace E (vector_span ℝ A) = vector_span ℝ (project_set E A) :=
begin
  simp only [project_subspace, map_vector_span, continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe],
  refl,
end

lemma vector_span_projection_sum_commute {C : multiset (set V)} {E : submodule ℝ V} :
vector_span ℝ (project_collection Eᗮ C).sum = project_subspace Eᗮ (vector_span ℝ C.sum) :=
begin
  simp only [project_collection],
  rw [←multiset_sum_project_set_commute C Eᗮ],
  simp only [project_subspace, project_set],
  rw [map_vector_span (orthogonal_projection Eᗮ).to_linear_map],
  simp only [continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe],
end

lemma common_dimension_projection {C : multiset (set V)} {E : submodule ℝ V} :
common_dimension (project_collection Eᗮ C) =
finite_dimensional.finrank ℝ (project_subspace Eᗮ (vector_span ℝ C.sum)) :=
begin
 simp only [common_dimension],
 rw [vector_span_projection_sum_commute],
end

lemma kernel_eq (E : submodule ℝ V) :
(orthogonal_projection E).ker = (orthogonal_projection E).to_linear_map.ker :=
begin
  simp only [continuous_linear_map.ker],
  refl,
end

lemma common_dimension_project_collection (C : multiset (set V)) (E : submodule ℝ V) :
common_dimension (project_collection Eᗮ C) ≥ common_dimension C - finite_dimensional.finrank ℝ E :=
begin
  simp only [common_dimension_projection],
  dsimp only [project_subspace, common_dimension, vector_span],
  have rn := dim_image_ge_dim_domain_sub_dim_ker (orthogonal_projection Eᗮ).to_linear_map (submodule.span ℝ (C.sum -ᵥ C.sum)),
  have : (orthogonal_projection Eᗮ).to_linear_map.ker = E :=
  begin
    rw [←kernel_eq Eᗮ],
    convert ker_of_orthogonal_projection Eᗮ,
    simp only [submodule.orthogonal_orthogonal E],
  end,
  rw [this] at rn,
  assumption,
end

lemma finrank_le_of_le {E F : submodule ℝ V} (h : E ≤ F) : dim E ≤ dim F :=
begin
  have ok : ∀ x : E, E.subtype x ∈ F :=
  begin
    intro x,
    apply h,
    simp only [submodule.coe_subtype, submodule.coe_mem],
  end,
  let f := E.subtype.cod_restrict F ok,
  have f_inj : function.injective f :=
  begin
    refine (@set.injective_cod_restrict _ _ E.subtype F ok).mpr _,
    apply submodule.injective_subtype,
  end,
  apply linear_map.finrank_le_finrank_of_injective f_inj,
end

/- lemma vector_span_ball {x : V} {ε : ℝ} (εpos : ε > 0) :
vector_span ℝ (metric.ball x ε) = ⊤ := sorry -/

lemma span_top_of_ball_subset {A : set V} {x : V} {ε : ℝ} (εpos : ε > 0)
(h : metric.ball x ε ⊆ A) : submodule.span ℝ A = ⊤ :=
begin
  simp only [←top_le_iff],
  rintro v -,
  by_cases he : v = x,
  {
    rw [he],
    apply submodule.subset_span,
    apply h,
    apply metric.mem_ball_self εpos,
  },
  let w := (ε / (2 * ∥v - x∥)) • (v - x) + x,
  have hz := he ∘ norm_sub_eq_zero_iff.mp,
  have hpos := norm_sub_pos_iff.mpr he,
  have hw : w ∈ submodule.span ℝ A,
  {
    simp only [w],
    apply submodule.subset_span,
    apply h,
    simp only [metric.mem_ball, dist_eq_norm],
    simp only [one_div, mul_inv_rev, add_sub_cancel, norm_smul],
    simp only [real.norm_eq_abs, abs_div, abs_mul, abs_two, abs_norm_eq_norm],
    simp only [abs_eq_self.mpr (le_of_lt εpos), div_mul_eq_div_div],
    simp only [div_mul],
    rw [div_self hz, div_one],
    exact half_lt_self εpos,
  },
  have hx : x ∈ submodule.span ℝ A,
  {
    apply submodule.subset_span,
    apply h,
    apply metric.mem_ball_self εpos,
  },
  have hvw : v = (2 * ∥v - x∥ / ε) • (w - x) + x,
  {
    simp only [w, add_sub_cancel, smul_smul],
    rw [div_mul_div_cancel _ (ne_of_gt εpos)],
    rw [div_self (double_ne_zero hz)],
    simp only [one_smul, sub_add_cancel],
  },
  rw [hvw],
  refine submodule.add_mem _ _ _,
  {
    refine submodule.smul_mem _ _ _,
    refine submodule.sub_mem _ _ _,
    all_goals {assumption},
  },
  {assumption},
end

lemma vector_span_top_of_ball_subset {A : set V} {x : V} {ε : ℝ} (εpos : ε > 0)
(h : metric.ball x ε ⊆ A) : vector_span ℝ A = ⊤ :=
begin
  simp only [vector_span],
  suffices hh : metric.ball 0 ε ⊆ diff A,
  {
    exact span_top_of_ball_subset εpos hh,
  },
  intros y hy,
  simp only [metric.mem_ball] at hy,
  refine ⟨x + y, x, _, _, _⟩,
  {
    apply h,
    simp only [metric.mem_ball, dist_self_add_left],
    simpa only [dist_eq_norm, sub_zero] using hy,
  },
  {
    apply h,
    exact metric.mem_ball_self εpos,
  },
  {
    simp only [vsub_eq_sub, add_sub_cancel'],
  },
end

lemma le_orthogonal_symm (E F : submodule ℝ V) :
E ≤ Fᗮ ↔ F ≤ Eᗮ :=
begin
  suffices h : ∀ E F : submodule ℝ V, E ≤ Fᗮ → F ≤ Eᗮ,
  {
    split,
    all_goals {exact h _ _},
  },
  clear E F,
  intros E F h,
  rw [←submodule.orthogonal_orthogonal F],
  apply submodule.orthogonal_le,
  exact h,
end

lemma inner_orthogonal_eq_inner (E : submodule ℝ V)
(u : E) (x : V) : ⟪((proj E) x : V), (u : V)⟫_ℝ = ⟪x, u⟫_ℝ :=
begin
  symmetry,
  apply eq_of_sub_eq_zero,
  -- simp only [submodule.coe_inner],
  rw [←inner_sub_left],
  simp only [proj, continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe, orthogonal_projection_inner_eq_zero,
  submodule.coe_mem],
end

lemma map_proj_orthogonal (E F : submodule ℝ V) :
Fᗮ.map (proj E) = (F.comap E.subtype)ᗮ :=
begin
  rw [←submodule.orthogonal_orthogonal (Fᗮ.map (proj E))],
  refine congr_arg submodule.orthogonal _,
  ext,
  simp only [submodule.mem_map, submodule.mem_comap, submodule.mem_orthogonal, submodule.coe_subtype, submodule.coe_inner],
  simp only [forall_exists_index, and_imp, forall_apply_eq_imp_iff₂],
  split,
  {
    intros h,
    have : x.val ∈ Fᗮᗮ,
    {
      simp only [submodule.mem_orthogonal],
      intros u hu,
      have := h u hu,
      simpa only [inner_orthogonal_eq_inner] using this,
    },
    {
      simpa only [submodule.orthogonal_orthogonal] using this,
    },
  },
  {
    intros xF v hv,
    simp only [real_inner_comm] at hv,
    simpa only [inner_orthogonal_eq_inner] using hv x xF,
  },
end

lemma mem_orthogonal_span (A : set V) (x : V) :
x ∈ (submodule.span ℝ A)ᗮ ↔ ∀ u : V, u ∈ A → ⟪u, x⟫_ℝ = 0 :=
begin
  split,
  {
    rw [submodule.mem_orthogonal],
    intros hx u hu,
    refine hx u _,
    apply submodule.subset_span,
    exact hu,
  },
  {
    intro h,
    rw [submodule.mem_orthogonal],
    intros u hu,
    apply submodule.span_induction hu,
    {
      exact h,
    },
    {
      simp only [inner_zero_left],
    },
    {
      intros y z hy hz,
      simp only [inner_add_left, hy, hz, add_zero],
    },
    {
      intros a y hy,
      simp only [inner_smul_left, hy, mul_zero],
    },
  },
end

lemma singleton_add_space_eq {E : submodule ℝ V} {x : V}
(xE : x ∈ E) :
({x} : set V) + ↑E = ↑E :=
begin
  ext y, split,
  {
    rintro ⟨xx, e, hxx, eE, rfl⟩,
    rcases (set.eq_of_mem_singleton hxx).symm with rfl,
    exact E.add_mem xE eE,
  },
  {
    intros yE,
    exact ⟨x, y - x, set.mem_singleton _,
      E.sub_mem yE xE, add_sub_cancel'_right _ _⟩,
  },
end

lemma eq_orthogonal_symm (E F : submodule ℝ V) :
E = Fᗮ ↔ F = Eᗮ :=
begin
  split,
  all_goals {
    intro h,
    rw [h, submodule.orthogonal_orthogonal],
  },
end

lemma inner_left_continuous (u : V) :
continuous (flip inner u : V → ℝ) :=
begin
  let f : V → V × V := λ v, (v, u),
  let g : V × V → ℝ := λ x, ⟪x.fst, x.snd⟫_ℝ,
  let h := g ∘ f,
  have gc : continuous g := continuous_inner,
  have hc : continuous h := by continuity,
  exact hc,
end

lemma inner_right_continuous (u : V) :
continuous (inner u : V → ℝ) :=
begin
  let f : V → V × V := λ v, (u, v),
  let g : V × V → ℝ := λ x, ⟪x.fst, x.snd⟫_ℝ,
  let h := g ∘ f,
  have gc : continuous g := continuous_inner,
  have hc : continuous h := by continuity,
  exact hc,
end

lemma inner_product_space.to_dual_symm_apply'
{x : V} {y : normed_space.dual ℝ V} :
⟪x, (inner_product_space.to_dual ℝ V).symm y⟫_ℝ =
y x :=
begin
  rw [real_inner_comm],
  exact inner_product_space.to_dual_symm_apply,
end

noncomputable def of_dual' (f : V →ₗ[ℝ] ℝ) : V :=
(inner_product_space.to_dual ℝ V).symm
⟨f, linear_map.continuous_of_finite_dimensional f⟩

lemma coe_ball_submodule {E : submodule ℝ V} (u : E) (ε : ℝ) :
coe '' metric.ball u ε = metric.ball (u : V) ε ∩ E :=
begin
  ext,
  simp only [set.mem_image, metric.mem_ball, set.mem_inter_iff],
  split,
  {
    rintro ⟨e, he, rfl⟩,
    refine ⟨_, e.property⟩,
    simpa only [subtype.dist_eq] using he,
  },
  {
    rintro ⟨h, xE⟩,
    refine ⟨⟨x, xE⟩, _, rfl⟩,
    {
      simpa only [subtype.dist_eq, subtype.coe_mk] using h,
    },
  },
end

lemma ball_spans_submodule (E : submodule ℝ V) (u : V) (uE : u ∈ E)
{ε : ℝ} (εpos : ε > 0) :
submodule.span ℝ (metric.ball u ε ∩ E) = E :=
begin
  let u' : E := ⟨u, uE⟩,
  suffices h : submodule.span ℝ (metric.ball u' ε) = ⊤,
  {
    simp only [u'] at h,
    replace h := congr_arg (submodule.map E.subtype) h,
    simp only [submodule.map_span] at h,
    simp only [submodule.coe_subtype, submodule.map_subtype_top] at h,
    simpa only [coe_ball_submodule, submodule.coe_mk] using h,
  },
  exact span_top_of_ball_subset εpos (subset_refl _),
end

lemma dist_inner_inner
(v₁ v₂ w₁ w₂ : V) :
⟪v₁, w₁⟫_ℝ ≤ ⟪v₂, w₂⟫_ℝ + (∥v₂ - v₁∥ * ∥w₁∥ + ∥v₂∥ * ∥w₂ - w₁∥) :=
begin
  conv {
    to_lhs,
    rw [←add_sub_cancel'_right v₂ v₁],
    simp only [inner_add_left],
  },
  conv {
    to_lhs,
    congr,
    {
      rw [←add_sub_cancel'_right w₂ w₁],
      simp only [inner_add_right],
    },
  },
  simp only [add_assoc],
  refine add_le_add_left _ _,
  refine le_trans (add_le_add (real_inner_le_norm _ _) (real_inner_le_norm _ _)) _,
  simp only [←dist_eq_norm],
  rw [dist_comm v₁ v₂, dist_comm w₁ w₂, add_comm],
end


import for_mathlib.nat
import o_minimal.examples.from_function_family
import o_minimal.o_minimal

/-
A function family on a linear order R is *isolating*
if any constraint f(x) = g(x) or f(x) < g(x) in n+1 variables x = (x₀, ..., xₙ)
is equivalent to one of the below:
- true;
- false;
- a constraint of one of the forms
  xₙ = h(x₀, ..., xₙ₋₁) or
  xₙ < h(x₀, ..., xₙ₋₁) or
  xₙ > h(x₀, ..., xₙ₋₁);
- a constraint f'(x) = g'(x) or f'(x) < g'(x)
  where f' and g' are functions (belonging to the family)
  of only the first n variables (x₀, ..., xₙ₋₁).
We refer to the last case as "pushing" the constraint down to
a constraint in only n variables.

We show that if a function family is isolating
then the associated definable sets form an o-minimal structure.

Examples:
* The family of simple functions (just constant functions and coordinate projections)
  is isolating, and defines the smallest o-minimal structure.
* Let R be an ordered vector space over an ordered field K (most commonly, R = K).
  Then the functions of the form x ↦ k₀ x₀ + ... + kₙ₋₁ xₙ₋₁ + r (with kᵢ ∈ K, r ∈ R)
  form an isolating family, which defines the o-minimal structure of semilinear sets.
-/

namespace o_minimal

open set
open_locale finvec

universe u

variables {R : Type u}
variables (F : function_family R)

section linear_order

variables [linear_order R]

/-- An isolated form for a constraint in n+1 variables:
either the last variable stands alone on one side of the constraint
or does not appear at all. -/
-- TODO: it quite looks as though we ought to have a data form of `constrained`
inductive isolated_constraint (n : ℕ) : Type u
| tt : isolated_constraint                   -- true
| ff : isolated_constraint                   -- false
| eq (h : F n) : isolated_constraint         -- xₙ = h(x')
| lt (h : F n) : isolated_constraint         -- xₙ < h(x')
| gt (h : F n) : isolated_constraint         -- xₙ > h(x')
| push_eq (f g : F n) : isolated_constraint  -- f(x') = g(x')
| push_lt (f g : F n) : isolated_constraint  -- f(x') < g(x')

namespace isolated_constraint

variables {F}

-- TODO: should we use `finvec.init x` instead of `F.extend_right`?
-- (They're equal by hypothesis, but not definitionally.)
def to_set {n : ℕ} :
  isolated_constraint F n → set (finvec (n + 1) R)
| tt := univ
| ff := ∅
| (eq h) := {x | x.last = F.extend_right h x}
| (lt h) := {x | x.last < F.extend_right h x}
| (gt h) := {x | x.last > F.extend_right h x}
| (push_eq f g) := {x | F.extend_right f x = F.extend_right g x}
| (push_lt f g) := {x | F.extend_right f x < F.extend_right g x}

end isolated_constraint

/-- A function family is *isolating* if any constraint in n+1 variables
is equivalent to an isolated constraint. -/
-- TODO: Should `isolate` be data?
-- Currently `constrained` only exists as a `Prop`, should it be data?
def function_family.is_isolating : Prop :=
∀ ⦃n : ℕ⦄ ⦃s : set (finvec (n + 1) R)⦄, constrained F s →
∃ (ic : isolated_constraint F n), ic.to_set = s

-- Henceforth, we assume the family F is isolating.
variables (hF : F.is_isolating)

-- Next, we show how to put a collection of constraints into "triangular form".

/-- The constraints on the last variable xₙ in a triangular form:
either a single constraint of the form xₙ = f(x'),
or two finite sets of constraints of the forms {gᵢ(x') < xₙ} and {xₙ < hⱼ(x')}.
(Here as usual x' denotes the remaining variables.)

No constraint (i.e. `true`) is represented by the second case, with empty sets.
`false` is not represented here; instead it gets pushed down to the base case
of the triangular form.
-/
inductive last_variable_constraints (n : ℕ) : Type u
| eq (f : F n) : last_variable_constraints
| between (lower upper : finset (F n)) : last_variable_constraints
-- Remark. We'll have to use classical to form the union of `finset`s.
-- A constructive treatment could use lists instead.

namespace last_variable_constraints

variables {F}

/-- The set defined by some last variable constraints. -/
def to_set {n : ℕ} :
  Π (c : last_variable_constraints F n), set (finvec (n + 1) R)
| (eq f) := {x | x.last = f x.init}
| (between lower upper) :=
    (⋂ (g : F n) (H : g ∈ lower), {x | g x.init < x.last}) ∩
    (⋂ (h : F n) (H : h ∈ upper), {x | x.last < h x.init})

@[simp]
lemma to_set_between_empty_empty {n : ℕ} :
  (between ∅ ∅ : last_variable_constraints F n).to_set = univ :=
by simp [to_set]

end last_variable_constraints

/-- A conjunction of constraints in n variables in "triangular form".
In the base case (n = 0) we have the logical constants true and false.
In the inductive case of n+1 variables we have
a conjunction of constraints on the last variable
and a triangular system of constraints on the first n variables.
-/
inductive triangular_constraints : Π (n : ℕ), Type u
| tt : triangular_constraints 0
| ff : triangular_constraints 0
| step {n : ℕ} :
    last_variable_constraints F n → triangular_constraints n → triangular_constraints (n+1)

namespace triangular_constraints

variables {F}

/-- The set defined by a triangular system of constraints. -/
def to_set :
  Π {n : ℕ} (t : triangular_constraints F n), set (finvec n R)
| 0 tt := univ
| 0 ff := ∅
| (n+1) (step c t') := c.to_set ∩ {x | x.init ∈ t'.to_set}

end triangular_constraints

section triangularize

-- Now we prove that triangular systems of constraints
-- have the same expressive power as arbitrary conjunctions of constraints.
-- For technical reasons we now assume `R` is nonempty (see `constrained.empty`).
variables [nonempty R]

-- First we show that any set defined by a triangular system of constraints
-- is also defined by a conjunction of constraints ("basic").

variables {F}

lemma last_variable_constraints.to_set_basic {n : ℕ} :
  ∀ (c : last_variable_constraints F n),
  finite_inter_closure (constrained F) c.to_set
| (last_variable_constraints.eq f) :=
begin
  apply finite_inter_closure.basic,
  convert constrained.EQ (F.coord (fin.last n)) (F.extend_right f),
  ext x, simp, refl
end
| (last_variable_constraints.between lower upper) :=
begin
  apply finite_inter_closure.inter;
    refine closed_under_finite_inters_finite_inter_closure.mem_fInter _ _;
    rintros i -;
    apply finite_inter_closure.basic;
  [ convert constrained.LT (F.extend_right i) (F.coord (fin.last n)),
    convert constrained.LT (F.coord (fin.last n)) (F.extend_right i) ];
  { ext x, simp [finvec.last] },
end

lemma triangular_constraints.to_set_basic :
  ∀ {n : ℕ} (t : triangular_constraints F n),
  finite_inter_closure (constrained F) t.to_set
| 0 triangular_constraints.tt := finite_inter_closure.univ
| 0 triangular_constraints.ff := finite_inter_closure.basic constrained.empty
| (n+1) (triangular_constraints.step c t') := begin
  refine finite_inter_closure.inter c.to_set_basic _,
  change finite_inter_closure (constrained F) (finvec.prod_univ t'.to_set 1),
  have IH : finite_inter_closure (constrained F) t'.to_set := t'.to_set_basic,
  -- TODO: move this somewhere sensible. Copied from `from_finite_inters`.
  have : preserves_finite_inters (λ s : set (finvec n R), finvec.prod_univ s 1),
  { split; intros; ext; simp [finvec.prod_univ] },
  refine this.bind _ t'.to_set IH,
  { intros s hs,
    apply finite_inter_closure.basic,
    exact hs.prod_r }
end

-- To prove the reverse implication, it suffices to show that
-- * a single constraint can be expressed as a triangular system;
-- * the sets defined by triangular systems of constraints are closed under finite intersections.

-- Preliminary constructions.

def triangular_constraints.extend_right {n : ℕ} (t : triangular_constraints F n) :
  triangular_constraints F (n+1) :=
triangular_constraints.step (last_variable_constraints.between ∅ ∅) t

@[simp]
lemma triangular_constraints.to_set_extend_right {n : ℕ} {t : triangular_constraints F n} :
  t.extend_right.to_set = {x | x.init ∈ t.to_set} :=
by simp [triangular_constraints.extend_right, triangular_constraints.to_set]

variables (F)

def triangular_constraints.ff_n : Π (n : ℕ), triangular_constraints F n
| 0 := triangular_constraints.ff
| (n+1) := (triangular_constraints.ff_n n).extend_right

def triangular_constraints.tt_n : Π (n : ℕ), triangular_constraints F n
| 0 := triangular_constraints.tt
| (n+1) := (triangular_constraints.tt_n n).extend_right

variables {F}

@[simp]
lemma triangular_constraints.to_set_ff_n {n : ℕ} : (triangular_constraints.ff_n F n).to_set = ∅ :=
begin
  induction n with n ih,
  { refl },
  { simp [triangular_constraints.ff_n, ih] }
end

@[simp]
lemma triangular_constraints.to_set_tt_n {n : ℕ} : (triangular_constraints.tt_n F n).to_set = univ :=
begin
  induction n with n ih,
  { refl },
  { simp [triangular_constraints.tt_n, ih] }
end

def triangular_constraints.last_variable_constraint {n : ℕ} (c : last_variable_constraints F n) :
  triangular_constraints F (n+1) :=
triangular_constraints.step c (triangular_constraints.tt_n F _)

@[simp]
lemma triangular_constraints.to_set_last_variable_constraint
  {n : ℕ} {c : last_variable_constraints F n} :
  (triangular_constraints.last_variable_constraint c).to_set = c.to_set :=
by simp [triangular_constraints.to_set, triangular_constraints.last_variable_constraint]

-- TODO: for_mathlib. Write a better proof.
lemma eq_empty_or_univ {α : Type*} [subsingleton α] (s : set α) : s = ∅ ∨ s = univ :=
begin
  classical,
  by_cases h : s = univ,
  { exact or.inr h },
  { left,
    rw eq_empty_iff_forall_not_mem,
    intro x,
    contrapose! h,
    ext y,
    have : x = y, by cc,
    subst y,
    simp [h] }
end

/-- Any subset of R⁰ = * can be described by a triangular system of constraints. -/
lemma triangular_constraints.zero {s : set (finvec 0 R)} :
  ∃ t : triangular_constraints F 0, t.to_set = s :=
begin
  -- We use classical here.
  -- If we carried a `constrained F s` hypothesis around,
  -- we'd see it really just needs the decidability of = and < on R.
  rcases eq_empty_or_univ s with rfl|rfl,
  { exact ⟨triangular_constraints.ff, rfl⟩ },
  { exact ⟨triangular_constraints.tt, rfl⟩ }
end

include hF

-- For the first part, we use the isolating property of F
-- to describe s by an isolated constraint, working by induction.
lemma triangular_constraints_of_constraint {n : ℕ} {s : set (finvec n R)} (hs : constrained F s) :
  ∃ t : triangular_constraints F n, t.to_set = s :=
begin
  induction n with n IH,
  { exact triangular_constraints.zero },
  { obtain ⟨i, rfl⟩ := hF hs, clear hs,
    rcases i with _|_|h|h|h|⟨f,g⟩|⟨f,g⟩,
    -- true or false; we built these earlier.
    { exact ⟨triangular_constraints.tt_n F _, triangular_constraints.to_set_tt_n⟩ },
    { exact ⟨triangular_constraints.ff_n F _, triangular_constraints.to_set_ff_n⟩ },
    -- an isolated constraint involving the last variable.
    { refine ⟨triangular_constraints.last_variable_constraint (last_variable_constraints.eq h), _⟩,
      simp [last_variable_constraints.to_set, isolated_constraint.to_set] },
    { refine ⟨triangular_constraints.last_variable_constraint (last_variable_constraints.between ∅ {h}), _⟩,
      simp [last_variable_constraints.to_set, isolated_constraint.to_set] },
    { refine ⟨triangular_constraints.last_variable_constraint (last_variable_constraints.between {h} ∅), _⟩,
      simp [last_variable_constraints.to_set, isolated_constraint.to_set] },
    -- a constraint that can be pushed down to the previous level, using the inductive hypothesis.
    { obtain ⟨t, ht⟩ := IH (constrained.EQ f g),
      refine ⟨t.extend_right, _⟩,
      simp [ht, isolated_constraint.to_set] },
    { obtain ⟨t, ht⟩ := IH (constrained.LT f g),
      refine ⟨t.extend_right, _⟩,
      simp [ht, isolated_constraint.to_set] } }
end

-- Now we show the sets described by triangular constraints are closed under finite intersections.
-- We already checked nullary intersections (via `.tt_n`),
-- so it remains to handle binary intersections.
-- The idea is to combine the last variable constraints and handle the rest by induction.
-- For the last variable constraints, there are two possibilities.
-- * If at least one is an equality constraint, we pick one such and keep it
--   and use it to rewrite the other constraint(s) in terms of earlier variables
--   (using the inductive hypothesis and the fact we've already shown that
--   a single constraint can be put in triangular form).
-- * Otherwise, both are between constraints and we can simply merge the sets.

lemma triangular_constraints.closed_under_finite_intersections {n : ℕ} :
  closed_under_finite_inters {s | ∃ t : triangular_constraints F n, t.to_set = s} :=
begin
  induction n using nat.rec_plus_one with n IH;
    refine { mem_univ := ⟨triangular_constraints.tt_n F _, by simp⟩, mem_inter := _ },
  { intros, exact triangular_constraints.zero },
  -- Now equipped with the inductive hypothesis,
  -- we handle the case of an equation as one of the last variable constraints.
  have eq_case :
    ∀ (f : F n) (t₁' : triangular_constraints F n) (t₂ : triangular_constraints F (n+1)),
    ∃ t₃ : triangular_constraints F (n + 1),
    t₃.to_set =
      (triangular_constraints.step (last_variable_constraints.eq f) t₁').to_set ∩ t₂.to_set,
  { intros f t₁' t₂,
    set t₁ := triangular_constraints.step (last_variable_constraints.eq f) t₁',
    rcases t₂ with _ | _ | ⟨_, c₂, t₂'⟩,
    -- Using the equation that the last variable equals f applied to the earlier ones,
    -- convert the last variable constraints of t₂ to constraints on only earlier variables.
    -- (The new constraints cut out the same set as the old last variable constraints
    -- at least when restricted to the set where t₁ holds.)
    have : ∃ t₂'' : triangular_constraints F n,
      t₁.to_set ∩ c₂.to_set = t₁.to_set ∩ {x | x.init ∈ t₂''.to_set},
    { -- We actually only care about the equality on the last variable, not all of t₁.
      suffices : ∃ t₂'' : triangular_constraints F n,
        {x : finvec (n + 1) R | x.last = f x.init} ∩ c₂.to_set =
        {x : finvec (n + 1) R | x.last = f x.init} ∩ {x | x.init ∈ t₂''.to_set},
      { obtain ⟨t₂'', h⟩ := this,
        refine ⟨t₂'', _⟩,
        change (_ ∩ _) ∩ _ = (_ ∩ _) ∩ _,
        conv_lhs { rw ←inter_right_comm },
        conv_rhs { rw ←inter_right_comm },
        congr' 1,
        exact h },
      rcases c₂ with f₂ | ⟨lower₂, upper₂⟩,
      { -- Convert f(x) = f₂(x) into a triangular system.
        obtain ⟨t, ht⟩ := triangular_constraints_of_constraint hF (constrained.EQ f f₂),
        refine ⟨t, _⟩,
        -- TODO: maybe borrow proof ideas from the other case
        unfold last_variable_constraints.to_set,
        convert_to
          {x : finvec (n + 1) R | x.last = f x.init} ∩
          {x : finvec (n + 1) R | f x.init = f₂ x.init} =
          {x : finvec (n + 1) R | x.last = f x.init} ∩
          {x : finvec (n + 1) R | x.init ∈ triangular_constraints.to_set _},
        { ext x, simp only [mem_inter_iff, mem_set_of_eq], split; rintros ⟨_, _⟩; cc },
        congr,
        simp_rw ht,
        refl },
      { -- Convert each g(x) < f(x) for g ∈ lower₂, f(x) < h(x) for h ∈ upper₂
        -- into a triangular system, and then combine them:
        -- we can do this using the inductive hypothesis.
        let S : set (finvec n R) :=
          (⋂ (g : F n) (H : g ∈ lower₂), {x | g x < f x}) ∩
          (⋂ (h : F n) (H : h ∈ upper₂), {x | f x < h x}),
        obtain ⟨t, ht⟩ : ∃ t : triangular_constraints F n, t.to_set = S,
        { apply IH.mem_inter; apply IH.mem_fInter,
          { intros g H, exact triangular_constraints_of_constraint hF (constrained.LT g f) },
          { intros h H, exact triangular_constraints_of_constraint hF (constrained.LT f h) } },
        refine ⟨t, _⟩,
        ext x,
        simp only [mem_inter_iff, mem_set_of_eq],
        apply and_congr_right,
        intro hx,
        simp [last_variable_constraints.to_set, hx, ht], } },
    obtain ⟨t₂'', ht₂''⟩ := this,
    -- Using the inductive hypothesis, combine the constraints t₁', t₂' and t₂''.
    -- TODO: Can probably be expressed more efficiently using new IH form.
    -- Otherwise, maybe state a lemma for this IH.mem_inter ⟨_, rfl⟩ ⟨_, rfl⟩ pattern.
    obtain ⟨t₃', ht₃' : t₃'.to_set = t₂''.to_set ∩ t₂'.to_set⟩ := IH.mem_inter ⟨t₂'', rfl⟩ ⟨t₂', rfl⟩,
    obtain ⟨t₄', ht₄' : t₄'.to_set = t₁'.to_set ∩ t₃'.to_set⟩ := IH.mem_inter ⟨t₁', rfl⟩ ⟨t₃', rfl⟩,
    refine ⟨triangular_constraints.step (last_variable_constraints.eq f) t₄', _⟩,
    change _ = _ ∩ (_ ∩ _),
    rw [←inter_assoc, ht₂''],
    simp only [triangular_constraints.to_set, t₁, ht₂'', ht₃', ht₄'],
    ext x,
    simp only [mem_inter_iff, mem_set_of_eq],
    tauto },
  -- Main proof: case analysis on the constraints.
  -- If either is an equality, apply eq_case, possibly after swapping the constraints.
  rintros _ _ ⟨t₁, rfl⟩ ⟨t₂, rfl⟩,
  rcases t₁ with _ | _ | ⟨_, f₁ | ⟨lower₁, upper₁⟩, t₁'⟩, { apply eq_case },
  rcases t₂ with _ | _ | ⟨_, f₂ | ⟨lower₂, upper₂⟩, t₂'⟩, { simp_rw [inter_comm], apply eq_case },
  -- In the remaining case, both are between constraints.
  obtain ⟨t₃', ht₃'⟩ := IH.mem_inter ⟨t₁', rfl⟩ ⟨t₂', rfl⟩,
  classical,
  refine
    ⟨triangular_constraints.step
      (last_variable_constraints.between (lower₁ ∪ lower₂) (upper₁ ∪ upper₂))
      t₃', _⟩,
  ext,
  simp only [triangular_constraints.to_set, last_variable_constraints.to_set, ht₃'],
  rw [finset.bInter_inter, finset.bInter_inter],
  simp only [mem_inter_iff, mem_set_of_eq],
  tauto
end

-- Finally, summarize all the results of this section.

/-- The sets described by triangular systems are the same as
those defined by finitely many constraints. -/
lemma triangular_constraints_iff {n : ℕ} (s : set (finvec n R)) :
  finite_inter_closure (constrained F) s ↔ ∃ t : triangular_constraints F n, t.to_set = s :=
begin
  split,
  { apply preserves_finite_inters_id.bind'
      (triangular_constraints.closed_under_finite_intersections hF),
    intros s hs,
    exact triangular_constraints_of_constraint hF hs },
  { rintros ⟨t, rfl⟩, exact t.to_set_basic }
end

lemma triangular_constraints_iff' {n : ℕ} :
  finite_inter_closure (constrained F) = {s | ∃ t : triangular_constraints F n, t.to_set = s} :=
set.ext (triangular_constraints_iff hF)

end triangularize

end linear_order

section DUNLO

variables [DUNLO R]
variables {F} (hF : F.is_isolating)

section projection

include hF

-- Now we show that the projection of the set described by a triangular system of constraints
-- is again described by a triangular system of constraints.
-- For this we need the hypothesis that R is a DUNLO.

lemma triangular_projection {n : ℕ} (t : triangular_constraints F (n+1)) :
  ∃ t' : triangular_constraints F n, t'.to_set = t.to_set.image finvec.init :=
begin
  rcases t with _ | _ | ⟨_, f | ⟨lower, upper⟩, t⟩,
  { -- Easy case: for an equality constraint,
    -- there is always a (unique) way to extend to the last variable.
    refine ⟨t, _⟩,
    simp only [triangular_constraints.to_set, last_variable_constraints.to_set],
    ext y,
    simp [finvec.mem_image_init] },
  { -- Harder case: for a between constraint,
    -- the constraint is satisfiable for given values of the earlier variables
    -- when all of the lower functions are less than all of the upper functions.
    let S := (⋂ (g : F n) (Hg : g ∈ lower) (h : F n) (Hh : h ∈ upper), {x | g x < h x}) ∩ t.to_set,
    have : ∃ t' : triangular_constraints F n, t'.to_set = S,
    { refine (triangular_constraints.closed_under_finite_intersections hF).mem_inter _ ⟨t, rfl⟩,
      apply (triangular_constraints.closed_under_finite_intersections hF).mem_fInter, intros g Hg,
      apply (triangular_constraints.closed_under_finite_intersections hF).mem_fInter, intros h Hh,
      apply triangular_constraints_of_constraint hF (constrained.LT g h) },
    obtain ⟨t', ht'⟩ := this,
    refine ⟨t', _⟩,
    rw ht',
    ext y,
    rw finvec.mem_image_init,
    simp only [triangular_constraints.to_set, last_variable_constraints.to_set,
      mem_inter_eq, mem_Inter, exists_and_distrib_right, mem_set_of_eq, finvec.init_snoc, finvec.last_snoc],
    congr',
    classical,
    have := order_constraints_feasible_iff (lower.image (λ (g : F n), g y)) (upper.image (λ (h : F n), h y)),
    simpa only [←finset.mem_coe, finset.coe_image, ball_image_iff, iff_iff_eq] using this.symm }
end

end projection

section o_minimal

-- At long last, we can prove that an isolating family gives rise to an o-minimal structure.

-- TODO: We should probably change all of these to use ⦃n⦄ binders
variables (D B P : Π {n : ℕ}, set (finvec n R) → Prop)
-- These could all just be `rfl`, but we build in the option of
-- non-definitional equalities for more flexibility
-- (possibly useless in this particular situation).
variables (hD : @D = λ {n : ℕ}, finite_union_closure (@B n))
variables (hB : @B = λ {n : ℕ}, finite_inter_closure (@P n))
variables (hP : @P = λ {n : ℕ}, constrained F)
include hD hB hP hF

lemma function_family_struc_hypotheses_of_isolating :
  function_family_struc_hypotheses F @D @B @P :=
{ definable_iff_finite_union_basic := by { rw hD, intros, refl },
  basic_iff_finite_inter_primitive := by { rw hB, intros, refl },
  primitive_iff_constrained := by { rw hP, intros, refl },
  definable_proj1_basic := begin
    subst hP,
    subst hB,
    subst hD,
    intros n s hs,
    apply finite_union_closure.basic,
    dsimp at hs ⊢,
    rw triangular_constraints_iff' hF at hs ⊢,
    obtain ⟨t, rfl⟩ := hs,
    exact triangular_projection hF t
  end }

/-- The structure defined by an isolating family. We'll prove below that it's o-minimal. -/
def struc_of_isolating : struc R :=
struc_of_function_family $
function_family_struc_hypotheses_of_isolating hF @D @B @P hD hB hP

omit hD hB hP

/-- The structure defined by an isolating family, with the default definition of definable sets. -/
def struc_of_isolating' : struc R :=
struc_of_isolating hF _ _ _ rfl rfl rfl

lemma struc_of_isolating'_definable {n : ℕ} (s : set (finvec n R)) :
  (struc_of_isolating' hF).definable s =
  finite_union_closure (finite_inter_closure (constrained F)) s :=
rfl

lemma o_minimal_of_isolating : o_minimal (struc_of_isolating hF @D @B @P hD hB hP) :=
o_minimal_of_function_family
{ tame_of_constrained := begin
    intros s hs,
    obtain ⟨ic, rfl⟩ := hF hs, clear hs,
    rcases ic with _ | _ | h | h | h | ⟨f,g⟩ | ⟨f,g⟩,
    { apply tame_univ },
    { apply tame_empty },
    { convert_to tame {r | r = h fin_zero_elim},
      { ext r,
        change r = _ ↔ r = h _,
        rw [function_family.extend_right_app],
        congr' },
      exact tame_single (interval_or_point.pt _) },
    { convert_to tame {r | r < h fin_zero_elim},
      { ext r,
        change r < _ ↔ r < h _,
        rw [function_family.extend_right_app],
        congr' },
      exact tame_single (interval_or_point.Iio _) },
    { convert_to tame {r | r > h fin_zero_elim},
      { ext r,
        change r > _ ↔ r > h _,
        rw [function_family.extend_right_app],
        congr' },
      exact tame_single (interval_or_point.Ioi _) },
    { convert_to tame {r | f fin_zero_elim = g fin_zero_elim},
      { ext r,
        change _ = _ ↔ _ = _,
        rw [function_family.extend_right_app, function_family.extend_right_app],
        congr' },
      apply tame_const },
    { convert_to tame {r | f fin_zero_elim < g fin_zero_elim},
      { ext r,
        change _ < _ ↔ _ < _,
        rw [function_family.extend_right_app, function_family.extend_right_app],
        congr' },
      apply tame_const }
  end,
  .. function_family_struc_hypotheses_of_isolating hF @D @B @P hD hB hP }

end o_minimal

end DUNLO

end o_minimal


/-
5. Prove as many of the identities listed in Section 4.4 as you can.
-/

open classical

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

example : (∃ x : α, r) → r :=
    assume h : ∃ x : α, r,
    exists.elim h
    (
        assume xx : α,
        id
    )
--short version
example : (∃ x : α, r) → r :=
    λ ⟨xx, hr⟩, hr

example : r → (∃ x : α, r) :=
    assume hr : r,
    exists.intro a hr
-- short version
example : r → (∃ x : α, r) :=
    λ hr, ⟨a, hr⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    iff.intro
    (
        assume h : ∃ x, p x ∧ r,
        exists.elim h
        (
            assume xx : α,
            assume h1 : p xx ∧ r,
            and.intro
            (
                show ∃ x, p x, from exists.intro xx h1.left
            )
            (
                show r, from h1.right
            )
        )
    )
    (
        assume h : (∃ x, p x) ∧ r,
        have h1 : ∃ x, p x, from h.left,
        have h2 : r, from h.right,
        exists.elim h1
        (
            assume xx : α,
            assume hpxx : p xx,
            show ∃ x, p x ∧ r, from
                exists.intro xx (and.intro hpxx h2)
        )
    )
-- short version
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    ⟨λ ⟨xx, hl, hr⟩, ⟨⟨xx, hl⟩, hr⟩, λ ⟨⟨xx, hpxx⟩, hr⟩, ⟨xx, hpxx, hr⟩⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    iff.intro
    (
        assume h : ∃ x, p x ∨ q x,
        exists.elim h
        (
            assume xx : α,
            assume h1 : p xx ∨ q xx,
            or.elim h1
            (
                assume h2 : p xx,
                show (∃ x, p x) ∨ (∃ x, q x), from
                    or.inl (exists.intro xx h2)
            )
            (
                assume h2 : q xx,
                show (∃ x, p x) ∨ (∃ x, q x), from
                    or.inr (exists.intro xx h2)
            )
        )
    )
    (
        assume h : (∃ x, p x) ∨ (∃ x, q x),
        or.elim h
        (
            assume h1 : ∃ x, p x,
            exists.elim h1
            (
                assume xx : α,
                assume h2 : p xx,
                show ∃ x, p x ∨ q x, from
                    exists.intro xx (or.inl h2)
            )
        )
        (
            assume h1 : ∃ x, q x,
            exists.elim h1
            (
                assume xx : α,
                assume h2 : q xx,
                show ∃ x, p x ∨ q x, from
                    exists.intro xx (or.inr h2)
            )
        )
    )
-- short version
example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    iff.intro
    (
        λ ⟨xx, h1⟩,
        h1.elim
        (λ hpxx, or.inl ⟨xx, hpxx⟩)
        (λ hqxx, or.inr ⟨xx, hqxx⟩)
    )
    (
        λ h,
        h.elim
        (λ ⟨xx, hpxx⟩, ⟨xx, or.inl hpxx⟩)
        (λ ⟨xx, hqxx⟩, ⟨xx, or.inr hqxx⟩)
    )

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    iff.intro
    (
        assume h : ∀ x, p x,
        show ¬ (∃ x, ¬ p x), from
            assume ⟨xx, hnpxx⟩,
            hnpxx (h xx)
    )
    (
        assume h : ¬ (∃ x, ¬ p x),
        assume xx : α,
        by_contradiction
        (
            assume h1 : ¬ p xx,
            h (exists.intro xx h1)
        )
    )
-- short version
example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    iff.intro
    (
        λ h, λ ⟨xx, hnpxx⟩, hnpxx (h xx)
    )
    (
        λ h,
        λ xx,
        by_contradiction
        (λ h1, h (exists.intro xx h1))
    )

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    iff.intro
    (
        assume h : ∃ x, p x,
        exists.elim h
        (
            assume x1 : α,
            assume hpx1 : p x1,
            show ¬ (∀ x, ¬ p x), from
                assume h1 : ∀ x, ¬ p x,
                absurd hpx1 (h1 x1)
        )
    )
    (
        assume h : ¬ (∀ x, ¬ p x),
        by_contradiction
        (
            assume h1 : ¬ ∃ x, p x,
            have h2 : ∀ x, ¬ p x, from
                assume x1,
                assume h3 : p x1,
                have h4 : ∃ x, p x, from  ⟨x1, h3⟩,
                    show false, from h1 h4,
            show false, from h h2
        )
    )
-- short version
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    iff.intro
    (
        λ ⟨x1, hpx1⟩, λ h1, absurd hpx1 (h1 x1)
    )
    (
        λ h,
        by_contradiction
        (λ h1, h (λ x1, λ h2, h1 ⟨x1, h2⟩))
    )

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    iff.intro
    (
        assume h : ¬ ∃ x, p x,
        assume x1 : α,
        assume hpx1 : p x1,
        have h1 : ∃ x, p x, from
            exists.intro x1 hpx1,
        show false, from h h1
    )
    (
        assume h : ∀ x, ¬ p x,
        assume h1 : ∃ x, p x,
        exists.elim h1
        (
            assume x1 : α,
            assume hpx1 : p x1,
            show false, from (h x1) hpx1
        )
    )
-- short version
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    iff.intro
    (λ h, λ x1, λ hpx1, h (exists.intro x1 hpx1))
    (λ h, (λ ⟨x1, hpx1⟩, (h x1) hpx1))

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
    iff.intro
    (
        assume h : ¬ ∀ x, p x,
        by_contradiction
        (
            assume h1 : ¬ (∃ x, ¬ p x),
            have h2 : ∀ x, p x, from
                assume x1 : α,
                by_contradiction
                (
                    assume h3 : ¬ p x1,
                    h1 (exists.intro x1 h3)
                ),
            h h2
        )
    )
    (
        assume ⟨x1, hnpx1⟩,
        assume h1 : ∀ x, p x,
        absurd (h1 x1) hnpx1
    )

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
    iff.intro
    (
        assume h : ∀ x, p x → r,
        assume ⟨(x1 : α), (hpx1 : p x1)⟩,
        (h x1) hpx1
    )
    (
        assume h : (∃ x, p x) → r,
        assume x1 : α,
        assume hpx1 : p x1,
        h (exists.intro x1 hpx1)
    )

example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
    iff.intro
    (
        assume ⟨(x1 : α), (h1 : p x1 → r)⟩,
        assume h2 : ∀ x, p x,
        h1 (h2 x1)
    )
    (
        assume h : (∀ x, p x) → r,
        show ∃ x, p x → r, from
            by_cases
            (
                assume h1 : ∀ x, p x, ⟨a, λ h', h h1⟩
            )
            (
                assume h1 : ¬ ∀ x, p x,
                by_contradiction
                (
                    assume h2 : ¬ ∃ x, p x → r,
                    have h3 : ∀ x, p x, from
                        assume x,
                        by_contradiction
                        (
                            assume hnp : ¬ p x,
                            have h4 : ∃ x, p x → r, from
                                ⟨x, (assume hp, absurd hp hnp)⟩,
                            show false, from h2 h4
                        ),
                    show false, from h1 h3
                )
            )
    )

example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
    iff.intro
    (
        assume ⟨(x1 : α), (h1 : r → p x1)⟩,
        assume hr : r,
        exists.intro x1 (h1 hr)
    )
    (
        assume h : r → ∃ x, p x,
        by_contradiction
        (
            assume h1 : ¬ ∃ x, r → p x,
            have h2 : ∀ x, ¬ (r → p x), from
                assume x1 : α,
                assume h3 : r → p x1,
                show false, from h1 ⟨x1, h3⟩,
            have h3 : ∀ x, r ∧ ¬ p x, from
                assume x1 : α,
                (em r).elim
                (
                    assume hr : r,
                    (em (p x1)).elim
                    (assume hpx1, absurd (λ hp', hpx1) (h2 x1))
                    (assume hnpx1, ⟨hr, hnpx1⟩)
                )
                (
                    assume hnr,
                    false.elim ((h2 x1) (λ hp, absurd hp hnr))
                ),
            have h4 : ∀ x, ¬ p x, from
                assume x1 : α, (h3 x1).right,
            have hr : r, from (h3 a).left,
            match h hr with ⟨(x1 : α), (hpx1 : p x1)⟩ :=
                have hnpx1 : ¬ p x1, from h4 x1,
                hnpx1 hpx1
            end
        )
    )