/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/

import ring_theory.ideal.basic
import category_theory.preadditive.injective
import algebra.category.Module.abelian

/-!
# Injective modules

## Main definitions

* `module.injective`: an `R`-module `Q` is injective if and only if every injective `R`-linear
  map descends to a linear map to `Q`, i.e. in the following diagram, if `f` is injective then there
  is an `R`-linear map `h : Y ⟶ Q` such that `g = h ∘ f`
  ```
  X --- f ---> Y
  |
  | g
  v
  Q
  ```
* `module.Baer`: an `R`-module `Q` satisfies Baer's criterion if any `R`-linear map from an
  `ideal R` extends to an `R`-linear map `R ⟶ Q`

## Main statements

* `module.Baer.criterion`: an `R`-module is injective if it is Baer.

-/

noncomputable theory

universes u v

variables (R : Type u) [ring R] (Q : Type (max u v)) [add_comm_group Q] [module R Q]

/--An `R`-module `Q` is injective if and only if every injective `R`-linear map descends to a linear
map to `Q`, i.e. in the following diagram, if `f` is injective then there is an `R`-linear map
`h : Y ⟶ Q` such that `g = h ∘ f`
  ```
  X --- f ---> Y
  |
  | g
  v
  Q
  ```
-/
class module.injective : Prop :=
(out : ∀ (X Y : Type (max u v)) [add_comm_group X] [add_comm_group Y] [module R X] [module R Y]
  (f : X →ₗ[R] Y) (hf : function.injective f) (g : X →ₗ[R] Q),
  ∃ (h : Y →ₗ[R] Q), ∀ x, h (f x) = g x)

lemma module.injective_object_of_injective_module [module.injective.{u v} R Q] :
  category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R) :=
{ factors := λ X Y g f mn, begin
    rcases module.injective.out X Y f ((Module.mono_iff_injective f).mp mn) g with ⟨h, eq1⟩,
    exact ⟨h, linear_map.ext eq1⟩,
  end }

lemma module.injective_module_of_injective_object
  [category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R)] :
  module.injective.{u v} R Q :=
{ out := λ X Y ins1 ins2 ins3 ins4 f hf g, begin
    resetI,
    rcases @category_theory.injective.factors (Module R) _ ⟨Q⟩ _ ⟨X⟩ ⟨Y⟩ g f
      ((Module.mono_iff_injective _).mpr hf) with ⟨h, eq1⟩,
    refine ⟨h, λ x, by rw ← eq1; refl⟩,
  end }

lemma module.injective_iff_injective_object :
  module.injective.{u v} R Q ↔ category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R) :=
⟨λ h, @@module.injective_object_of_injective_module R _ Q _ _ h,
  λ h, @@module.injective_module_of_injective_object R _ Q _ _ h⟩

/--An `R`-module `Q` satisfies Baer's criterion if any `R`-linear map from an `ideal R` extends to
an `R`-linear map `R ⟶ Q`-/
def module.Baer : Prop := ∀ (I : ideal R) (g : I →ₗ[R] Q), ∃ (g' : R →ₗ[R] Q),
  ∀ (x : R) (mem : x ∈ I), g' x = g ⟨x, mem⟩

namespace Baer

variables {R} {M N : Type (max u v)} [add_comm_group M] [add_comm_group N]
variables [module R M] [module R N] {i : M →ₗ[R] N} (hi : function.injective i) (f : M →ₗ[R] Q)
variable {Q}
include hi

/-- If we view `M` as a submodule of `N` via the injective linear map `i : M ↪ N`, then a submodule
between `M` and `N` is a submodule `N'` of `N`. To prove Baer's criterion, we need to consider
pairs of `(N', f')` such that `M ≤ N' ≤ N` and `f'` extends `f`. -/
structure extension_of extends submodule R N :=
(le : i.range ≤ to_submodule)
(extension : to_submodule →ₗ[R] Q)
(is_extension: ∀ (m : M), f m = extension ⟨i m, le ⟨m, rfl⟩⟩)

@[ext]
lemma ext (a b : extension_of hi f) (submodule_eq : a.to_submodule = b.to_submodule)
  (extension_eq : ∀ x, a.extension x = b.extension ⟨x.1, submodule_eq ▸ x.2⟩) :
  a = b :=
begin
  rcases a with ⟨a, a_le, e1, _⟩,
  rcases b with ⟨b, b_le, e2, _⟩,
  dsimp only at *,
  subst' submodule_eq,
  have : e1 = e2,
  { ext z, exact eq.trans (extension_eq z) (congr_arg e2 (subtype.ext_val rfl)) },
  subst this,
end

lemma ext_iff (a b : extension_of hi f) :
  a = b ↔ ∃ (submodule_eq : a.to_submodule = b.to_submodule),
    ∀ x, a.extension x = b.extension ⟨x.1, submodule_eq ▸ x.2⟩ :=
⟨λ r, r ▸ ⟨rfl, λ x, congr_arg a.extension $ subtype.ext_val rfl⟩,
  λ ⟨h1, h2⟩, Baer.ext _ _ a b h1 h2⟩

instance : has_bot (extension_of hi f) :=
{ bot :=
  { to_submodule := i.range,
    le := le_refl _,
    extension :=
      { to_fun := λ x, f x.2.some,
        map_add' := λ x y, begin
          have eq1  : _ + _ = (x + y).1 := congr_arg2 (+) x.2.some_spec y.2.some_spec,
          rw [← map_add, ← (x + y).2.some_spec] at eq1,
          rw [← hi eq1, map_add],
        end,
        map_smul' := λ r x, begin
          have eq1 : r • _ = (r • x).1 := congr_arg ((•) r) x.2.some_spec,
          rw [← linear_map.map_smul, ← (r • x).2.some_spec] at eq1,
          rw [ring_hom.id_apply, ← hi eq1, linear_map.map_smul],
        end },
    is_extension := λ m, begin
      simp only [linear_map.coe_mk],
      erw hi (⟨i m, ⟨_, rfl⟩⟩ : i.range).2.some_spec,
    end } }

instance : inhabited (extension_of hi f) := ⟨⊥⟩

/--
We order the extensions by `(M1, e1) ≤ (M2, e2)` if and only if `M1 ≤ M2` and `e2` extends `e1`.
-/
instance : has_le (extension_of hi f) :=
{ le := λ X1 X2, nonempty
    Σ' (h : X1.to_submodule ≤ X2.to_submodule),
      ∀ (m : X1.to_submodule), X2.extension ⟨m, h m.2⟩ = X1.extension m }

instance : partial_order (extension_of hi f) :=
{ le := (≤),
  le_refl := λ a, nonempty.intro
    ⟨le_refl _, λ _, congr_arg _ (subtype.ext_val rfl) ⟩,
  le_antisymm := λ a b ⟨⟨le_ab, hab⟩⟩ ⟨⟨le_ba, hba⟩⟩,
    let m_eq : a.to_submodule = b.to_submodule := (le_antisymm le_ab le_ba) in
    ext _ _ _ _ m_eq (λ x, by convert hba ⟨x, m_eq ▸ x.2⟩; rw subtype.ext_iff_val; refl),
  le_trans := λ a b c ⟨⟨le_ab, hab⟩⟩ ⟨⟨le_bc, hbc⟩⟩, nonempty.intro
    ⟨le_trans le_ab le_bc, λ z, by rw [← hab z, ← hbc ⟨z, le_ab z.2⟩]; refl⟩ }

variables {R i hi f}
lemma directed_on' {c : set (extension_of hi f)} (hchain : is_chain (≤) c) :
  directed_on (≤) c := directed_on_iff_directed.mpr $ is_chain.directed hchain

lemma exists3 {c : set (extension_of hi f)} (hchain : is_chain (≤) c) {α β γ}
  (mem1 : α ∈ c) (mem2 : β ∈ c) (mem3 : γ ∈ c) :
  ∃ (z) (mem4 : z ∈ c), α ≤ z ∧ β ≤ z ∧ γ ≤ z :=
begin
  rcases directed_on' hchain _ mem1 _ mem2 with ⟨z1, ⟨z1_mem, hz1⟩⟩,
  rcases directed_on' hchain z1 z1_mem _ mem3 with ⟨z, ⟨z_mem, hz⟩⟩,
  exact ⟨z, z_mem, le_trans hz1.1 hz.1, le_trans hz1.2 hz.1, hz.2⟩,
end

lemma chain_submodule_of_chain_extension_of
  {c : set (extension_of hi f)} (hchain : is_chain (≤) c) :
  (is_chain (≤) $ (λ x : extension_of hi f, x.to_submodule) '' c) :=
begin
  rintro _ ⟨a, a_mem, rfl⟩ _ ⟨b, b_mem, rfl⟩ (neq : a.to_submodule ≠ b.to_submodule),
  rcases hchain a_mem b_mem (λ r, neq $ r ▸ rfl) with ⟨⟨le1, -⟩⟩ | ⟨⟨le1, -⟩⟩;
  tauto,
end

lemma submodule_le_of_extension_of_le {a b : extension_of hi f} (le1 : a ≤ b) :
  a.to_submodule ≤ b.to_submodule := le1.some.1

lemma directed_on_of_chain {c : set (extension_of hi f)} (hchain : is_chain (≤) c) :
  directed_on (≤) $ (λ x : extension_of hi f, x.to_submodule) '' c :=
begin
  rw directed_on_iff_directed,
  rintros ⟨_, ⟨a, a_mem, rfl⟩⟩ ⟨_, ⟨b, b_mem, rfl⟩⟩,
  by_cases eq1 : a = b,
  { exact ⟨⟨a.to_submodule, ⟨_, a_mem, rfl⟩⟩, le_refl _, by convert (le_refl _)⟩ },
  { exact or.elim (hchain a_mem b_mem eq1)
      (λ h, ⟨⟨b.to_submodule, ⟨_, b_mem, rfl⟩⟩, submodule_le_of_extension_of_le h, le_refl _⟩)
      (λ h, ⟨⟨a.to_submodule, ⟨_, a_mem, rfl⟩⟩, le_refl _, submodule_le_of_extension_of_le h⟩)}
end

lemma nonempty_of_extension_of {c : set (extension_of hi f)} (hnonempty : c.nonempty) :
  ((λ x : extension_of hi f, x.to_submodule) '' c).nonempty :=
⟨hnonempty.some.to_submodule, ⟨_, hnonempty.some_spec, rfl⟩⟩

/--For a nonempty chain of extensions of `f`, if `y` is in the supremum of underlying submodules of
the extensions in chain, then `y` is at least one of the underlying submodule in that chain.
`pick_submodule` picks that submodule-/
def pick_submodule {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  submodule R N :=
((submodule.mem_Sup_of_directed (nonempty_of_extension_of hnonempty)
  (directed_on_of_chain hchain)).mp y.2).some

lemma pick_submodule_mem_image {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  pick_submodule hchain hnonempty y ∈ ((λ x : extension_of hi f, x.to_submodule) '' c) :=
((submodule.mem_Sup_of_directed (nonempty_of_extension_of hnonempty)
  (directed_on_of_chain hchain)).mp y.2).some_spec.some

/--The submodule picked by `pick_submodule` is the underlying submodule of an element in the chain,
i.e. underlying submodule of some `extension_of f`, `pick_extension_of` picks that extension.
-/
def pick_extension_of {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  extension_of hi f :=
((submodule.mem_Sup_of_directed (nonempty_of_extension_of hnonempty)
  (directed_on_of_chain hchain)).mp y.2).some_spec.some.some

lemma pick_extension_of_mem {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  pick_extension_of hchain hnonempty y ∈ c :=
((submodule.mem_Sup_of_directed (nonempty_of_extension_of hnonempty)
  (directed_on_of_chain hchain)).mp y.2).some_spec.some.some_spec.1

lemma pick_extension_of_to_submodule_mem
  {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  y.1 ∈ (pick_extension_of hchain hnonempty y).to_submodule :=
begin
  unfold pick_extension_of,
  generalize_proofs h mem1,
  convert h.some_spec.some_spec,
  exact mem1.some_spec.2,
end

lemma pick_submodule_mem {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (y : Sup ((λ x : extension_of hi f, x.to_submodule) '' c)) :
  y.1 ∈ pick_submodule hchain hnonempty y :=
((submodule.mem_Sup_of_directed (nonempty_of_extension_of hnonempty)
  (directed_on_of_chain hchain)).mp y.2).some_spec.some_spec

/--Every nonempty chain of `extension_of` f has a maximal element, i.e. a pair of `(N', f')`, where
all underlying submodule is submodule of `M'` and `f'` extends all functions. `max_extension` is
this maximal function, it is defined by taking union of all functions in the chain.
-/
def extension_of.max_extension {c : set (extension_of hi f)}
  (hchain : is_chain (≤) c) (hnonempty : c.nonempty) :
  Sup ((λ x : extension_of hi f, x.to_submodule) '' c) → Q :=
λ y, (pick_extension_of hchain hnonempty y).extension
  ⟨y.1, by apply pick_extension_of_to_submodule_mem⟩

lemma extension_of.max_extension_property {c : set (extension_of hi f)}
  (hchain : is_chain (≤) c) (hnonempty : c.nonempty)
  (x : Sup ((λ x : extension_of hi f, x.to_submodule) '' c))
  {γ : extension_of hi f} (mem1 : γ ∈ c)
  (mem2 : x.1 ∈ γ.to_submodule) :
  extension_of.max_extension hchain hnonempty x = γ.extension ⟨x.1, mem2⟩ :=
begin
  unfold extension_of.max_extension,
  generalize_proofs mem3,
  by_cases eq_ineq : pick_extension_of hchain hnonempty x = γ,
  { rw ext_iff at eq_ineq,
    rcases eq_ineq with ⟨h1, h2⟩,
    convert h2 _, },
  { rcases hchain (pick_extension_of_mem hchain hnonempty x) mem1 eq_ineq with ⟨⟨_, h1⟩⟩|⟨⟨_, h1⟩⟩;
    rw ← h1 ⟨x.1, by assumption⟩;
    congr },
end

lemma extension_of.max_extension.map_add {c : set (extension_of hi f)}
  (hchain : is_chain (≤) c) (hnonempty : c.nonempty) (y1 y2):
  extension_of.max_extension hchain hnonempty (y1 + y2) =
  extension_of.max_extension hchain hnonempty y1 +
  extension_of.max_extension hchain hnonempty y2 :=
begin
  have mem_y1 := pick_extension_of_to_submodule_mem hchain hnonempty y1,
  have mem_y2 := pick_extension_of_to_submodule_mem hchain hnonempty y2,
  have mem_add :=  pick_extension_of_to_submodule_mem hchain hnonempty (y1 + y2),
  rw extension_of.max_extension_property hchain hnonempty y1
    (pick_submodule_mem_image hchain hnonempty y1).some_spec.1 mem_y1,
  rw extension_of.max_extension_property hchain hnonempty y2
    (pick_submodule_mem_image hchain hnonempty y2).some_spec.1 mem_y2,
  rw extension_of.max_extension_property hchain hnonempty _
    (pick_submodule_mem_image hchain hnonempty _).some_spec.1 mem_add,
  generalize_proofs hadd hy1 hy2,
  have := exists3 hchain hadd.some_spec.1 hy1.some_spec.1 hy2.some_spec.1,
  rcases this with ⟨_, _, ⟨⟨_, h1⟩⟩, ⟨⟨_, h2⟩⟩, ⟨⟨_, h3⟩⟩⟩,
  rw [← h1, ← h2, ← h3, ← map_add],
  congr,
end

lemma extension_of.max_extension.map_smul {c : set (extension_of hi f)}
  (hchain : is_chain (≤) c) (hnonempty : c.nonempty) (r : R) (y):
  extension_of.max_extension hchain hnonempty (r • y) =
  r • extension_of.max_extension hchain hnonempty y :=
begin
  have mem_y := pick_extension_of_to_submodule_mem hchain hnonempty y,
  have mem_smul := pick_extension_of_to_submodule_mem hchain hnonempty (r • y),
  rw extension_of.max_extension_property hchain hnonempty y
    (pick_submodule_mem_image hchain hnonempty y).some_spec.1 mem_y,
  rw extension_of.max_extension_property hchain hnonempty (r • y)
    (pick_submodule_mem_image hchain hnonempty (r • y)).some_spec.1 mem_smul,
  generalize_proofs inst hsmul hy,
  rcases directed_on' hchain _ hsmul.some_spec.1 _ hy.some_spec.1 with
    ⟨_, _, ⟨⟨_, h1⟩⟩, ⟨⟨_, h2⟩⟩⟩,
  rw [← h1, ← linear_map.map_smul, ← h2],
  congr,
end

/--The maximal element of every nonempty chain of `extension_of` f-/
def extension_of.max {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) :
  extension_of hi f :=
{ to_submodule := Sup ((λ x : extension_of hi f, x.to_submodule) '' c),
  le := begin
    cases hnonempty with j hj,
    exact le_trans j.le (le_Sup ⟨j, hj, rfl⟩),
  end,
  extension :=
  { to_fun := extension_of.max_extension hchain hnonempty,
    map_add' := extension_of.max_extension.map_add hchain hnonempty,
    map_smul' := extension_of.max_extension.map_smul hchain hnonempty },
  is_extension := λ m, begin
    dsimp,
    generalize_proofs im_mem,
    change _ = (pick_submodule_mem_image hchain hnonempty ⟨i m, im_mem⟩).some.extension _,
    generalize_proofs mem_image mem_submodule,
    rw (Exists.some mem_image).is_extension m,
    congr,
  end }

lemma extension_of.le_max {c : set (extension_of hi f)} (hchain : is_chain (≤) c)
  (hnonempty : c.nonempty) (a : extension_of hi f) (ha : a ∈ c) :
  a ≤ extension_of.max hchain hnonempty :=
begin
  unfold extension_of.max extension_of.max_extension,
  refine ⟨⟨le_Sup ⟨a, ha, rfl⟩, _⟩⟩,
  dsimp at *,
  generalize_proofs mem1 mem_image mem2,
  by_cases eq_ineq : pick_extension_of hchain hnonempty ⟨↑m, mem1⟩ = a,
  { rcases (ext_iff hi f _ _).mp eq_ineq with ⟨h1, h2⟩,
    convert h2 _,
    rw subtype.ext_iff_val,
    refl, },
  { rcases hchain (pick_extension_of_mem hchain hnonempty _) ha eq_ineq with
      ⟨⟨le1, h1⟩⟩|⟨le1, h1⟩,
    symmetry,
    all_goals { convert h1 _; rw subtype.ext_iff_val; refl }, },
end

lemma extension_of.aux1 : ∀ (c : set (extension_of hi f)),
  is_chain has_le.le c →
  c.nonempty →
  (∃ (ub : extension_of hi f), ∀ (a : extension_of hi f), a ∈ c → a ≤ ub) :=
λ c hchain hnonempty,
  ⟨extension_of.max hchain hnonempty, extension_of.le_max hchain hnonempty⟩

variables (hi f)
/--Since every nonempty chain has a maximal element, by Zorn's lemma, there is a maximal
`extension_of hi f`-/
def extension_of_max : extension_of hi f :=
(@zorn_nonempty_partial_order (extension_of hi f) _ _ (extension_of.aux1)).some

lemma extension_of_max_is_max :
  ∀ (a : extension_of hi f),
    (extension_of_max hi f) ≤ a → a = (extension_of_max hi f) :=
(@zorn_nonempty_partial_order (extension_of hi f) _ _ (extension_of.aux1)).some_spec

variables {hi f}
lemma extension_of_max_adjoin.aux1
  {y : N}
  (x : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y}) :
  ∃ (a : (extension_of_max hi f).to_submodule) (b : R), x.1 = a.1 + b • y :=
begin
  have mem1 : x.1 ∈ (_ : set _) := x.2,
  rw submodule.coe_sup at mem1,
  rcases mem1 with ⟨a, b, a_mem, (b_mem : b ∈ (submodule.span R _ : submodule R N)), eq1⟩,
  rw submodule.mem_span_singleton at b_mem,
  rcases b_mem with ⟨z, eq2⟩,
  exact ⟨⟨a, a_mem⟩, z, by rw [← eq1, ← eq2]⟩,
end

/--If `x ∈ M ⊔ ⟨y⟩`, then `x = m + r • y`, `fst` pick an arbitrary such `m`.-/
def extension_of_max_adjoin.fst
  {y : N} (x : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y}) :
  (extension_of_max hi f).to_submodule :=
(extension_of_max_adjoin.aux1 x).some

/--If `x ∈ M ⊔ ⟨y⟩`, then `x = m + r • y`, `snd` pick an arbitrary such `r`.-/
def extension_of_max_adjoin.snd
  {y : N} (x : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y}) :
  R :=
(extension_of_max_adjoin.aux1 x).some_spec.some

lemma extension_of_max_adjoin.eqn
  {y : N} (x : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y}) :
  x.1 = (extension_of_max_adjoin.fst x).1 + (extension_of_max_adjoin.snd x) • y :=
(extension_of_max_adjoin.aux1 x).some_spec.some_spec

variables (hi f)
/--the ideal `I = {r | r • y ∈ N}`-/
def extension_of_max_adjoin.ideal (y : N) :
  ideal R :=
{ carrier := {r | r • y ∈ (extension_of_max hi f).to_submodule},
  add_mem' := λ a b (ha : a • y ∈ _) (hb : b • y ∈ _), begin
    change (a + b) • _ ∈ _,
    rw [add_smul],
    exact submodule.add_mem _ ha hb,
  end,
  smul_mem' := λ c x (hx : x • y ∈ _), begin
    change (_ • _) • _ ∈ _,
    rw [smul_eq_mul, mul_smul],
    exact submodule.smul_mem _ _ hx,
  end,
  zero_mem' := by simp }

/--A linear map `I ⟶ Q` by `x ↦ f' (x • y)` where `f'` is the maximal extension-/
def extension_of_max_adjoin.ideal_to (y : N) :
  extension_of_max_adjoin.ideal hi f y →ₗ[R] Q :=
{ to_fun := λ z, (extension_of_max hi f).extension ⟨z.1 • y, z.2⟩,
  map_add' := λ z1 z2, by rw [← map_add]; congr; erw add_smul,
  map_smul' := λ z1 z2, begin
    rw [ring_hom.id_apply, ← linear_map.map_smul],
    exact congr_arg _ (subtype.ext_val (mul_smul _ _ _)),
  end }

lemma extension_of_max_adjoin.aux2 (h : module.Baer R Q) (y : N) :
  ∃ (g' : R →ₗ[R] Q), ∀ (x : R) (mem : x ∈ extension_of_max_adjoin.ideal hi f y),
    g' x = extension_of_max_adjoin.ideal_to hi f y ⟨x, mem⟩ :=
h (extension_of_max_adjoin.ideal hi f y) (extension_of_max_adjoin.ideal_to hi f y)

/-- Since we assumed `Q` being Baer, the linear map `x ↦ f' (x • y) : I ⟶ Q` extends to `R ⟶ Q`,
call this extended map `φ`-/
def extension_of_max_adjoin.extend_ideal_to (h : module.Baer R Q) (y : N) : R →ₗ[R] Q :=
(extension_of_max_adjoin.aux2 hi f h y).some

lemma extension_of_max_adjoin.extend_ideal_to_is_extension (h : module.Baer R Q) (y : N) :
  ∀ (x : R) (mem : x ∈ extension_of_max_adjoin.ideal hi f y),
  extension_of_max_adjoin.extend_ideal_to hi f h y x =
  extension_of_max_adjoin.ideal_to hi f y ⟨x, mem⟩ :=
(extension_of_max_adjoin.aux2 hi f h y).some_spec

lemma extension_of_max_adjoin.extend_ideal_to_wd' (h : module.Baer R Q) {y : N} (r : R)
  (eq1 : r • y = 0) :
  extension_of_max_adjoin.extend_ideal_to hi f h y r = 0 :=
begin
  rw extension_of_max_adjoin.extend_ideal_to_is_extension hi f h y r
    (by rw eq1; exact submodule.zero_mem _ : r • y ∈ _),
  unfold extension_of_max_adjoin.ideal_to,
  simp only [linear_map.coe_mk, eq1],
  convert map_zero _,
end

lemma extension_of_max_adjoin.extend_ideal_to_wd (h : module.Baer R Q) {y : N} (r r' : R)
  (eq1 : r • y = r' • y) :
  extension_of_max_adjoin.extend_ideal_to hi f h y r =
  extension_of_max_adjoin.extend_ideal_to hi f h y r' :=
begin
  rw [← sub_eq_zero, ← map_sub],
  convert extension_of_max_adjoin.extend_ideal_to_wd' hi f h (r - r') _,
  rw [sub_smul, sub_eq_zero, eq1],
end

lemma extension_of_max_adjoin.extend_ideal_to_eq (h : module.Baer R Q) {y : N} (r : R)
  (hr : r • y ∈ (extension_of_max hi f).to_submodule) :
  extension_of_max_adjoin.extend_ideal_to hi f h y r =
  (extension_of_max hi f).extension ⟨r • y, hr⟩ :=
by rw extension_of_max_adjoin.extend_ideal_to_is_extension hi f h _ _ hr; refl

/--We can finally define a linear map `M ⊔ ⟨y⟩ ⟶ Q` by `x + r • y ↦ f x + φ r`
-/
def extension_of_max_adjoin.extension_to_fun (h : module.Baer R Q)
  {y : N} :
  (extension_of_max hi f).to_submodule ⊔ submodule.span R {y} → Q :=
λ x, (extension_of_max hi f).extension (extension_of_max_adjoin.fst x) +
  extension_of_max_adjoin.extend_ideal_to hi f h y (extension_of_max_adjoin.snd x)

lemma extension_of_max_adjoin.extension_to_fun_wd (h : module.Baer R Q)
  {y : N} (x : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y})
  (a : (extension_of_max hi f).to_submodule) (r : R)
  (eq1 : x.1 = a.1 + r • y) :
  extension_of_max_adjoin.extension_to_fun hi f h x =
  (extension_of_max hi f).extension a +
  extension_of_max_adjoin.extend_ideal_to hi f h y r :=
begin
  have eq2 := eq1,
  rw [extension_of_max_adjoin.eqn, ← sub_eq_zero,
    show ∀ (a b c d : N), (a + b) - (c + d) = (a - c) - (d - b), from λ _ _ _ _, by abel,
    sub_eq_zero, ← sub_smul] at eq2,
  have eq3 := extension_of_max_adjoin.extend_ideal_to_eq hi f h (r - extension_of_max_adjoin.snd x)
    (by rw ← eq2; exact submodule.sub_mem _ (extension_of_max_adjoin.fst x).2 a.2),
  simp only [map_sub, sub_smul, sub_eq_iff_eq_add] at eq3,
  unfold extension_of_max_adjoin.extension_to_fun,
  rw [eq3, ← add_assoc],
  congr' 1,
  rw [← map_add, show ∀ (a b : (extension_of_max hi f).to_submodule), a + b = ⟨a.1 + b.1, _⟩,
    from λ _ _, rfl],
  have eq4 := extension_of_max_adjoin.eqn x,
  rw eq1 at eq4,
  simp only [eq4, add_sub, add_sub_cancel],
  exact congr_arg _ (subtype.ext_val rfl),
end

/--The linear map `M ⊔ ⟨y⟩ ⟶ Q` by `x + r • y ↦ f x + φ r` is an extension of `f`-/
def extension_of_max_adjoin (h : module.Baer R Q) (y : N) :
  extension_of hi f :=
{ to_submodule := (extension_of_max hi f).to_submodule ⊔ submodule.span R {y},
  le := le_trans (extension_of_max hi f).le le_sup_left,
  extension :=
    { to_fun := extension_of_max_adjoin.extension_to_fun hi f h,
      map_add' := λ a b, begin
        have eq1 : (a + b).val =
          ((extension_of_max_adjoin.fst a) + (extension_of_max_adjoin.fst b)).1 +
          (extension_of_max_adjoin.snd a + extension_of_max_adjoin.snd b) • y,
        { change a.1 + b.1 = _ + _,
          rw [extension_of_max_adjoin.eqn, extension_of_max_adjoin.eqn, add_smul],
          abel, },
        rw [extension_of_max_adjoin.extension_to_fun_wd hi f h (a + b) _ _ eq1, map_add, map_add],
        unfold extension_of_max_adjoin.extension_to_fun,
        abel,
      end,
      map_smul' := λ r a, begin
        rw [ring_hom.id_apply],
        have eq1 : (r • a).1 = (r • extension_of_max_adjoin.fst a).1 +
          (r • extension_of_max_adjoin.snd a) • y,
        { change r • a.1 = _,
          rw [extension_of_max_adjoin.eqn, smul_add, smul_eq_mul, mul_smul],
          refl, },
        rw [extension_of_max_adjoin.extension_to_fun_wd hi f h (r • a) _ _ eq1,
          linear_map.map_smul, linear_map.map_smul, ← smul_add],
        congr',
      end },
  is_extension := λ m, begin
    simp only [linear_map.coe_mk],
    generalize_proofs mem,
    rw [(extension_of_max hi f).is_extension, extension_of_max_adjoin.extension_to_fun_wd hi f h
      ⟨_, mem⟩ ⟨i m, _⟩ 0 (show i m = i m + (0 : R) • y, by simp), map_zero, add_zero],
  end }

lemma extension_of_max_le (h : module.Baer R Q) {y : N} :
  extension_of_max hi f ≤ extension_of_max_adjoin hi f h y := nonempty.intro
⟨le_sup_left, λ m, begin
  generalize_proofs mem,
  have eq1 : (⟨m.1, mem⟩ : (extension_of_max hi f).to_submodule ⊔ submodule.span R {y}).1 =
      m.1 + (0 : R) • y,
  { rw [zero_smul, add_zero], },
  change extension_of_max_adjoin.extension_to_fun hi f h ⟨m.1, mem⟩ = _,
  rw [extension_of_max_adjoin.extension_to_fun_wd hi f h _ _ _ eq1, map_zero, add_zero],
end⟩

lemma extension_of_max_eq (h : module.Baer R Q) (y : N) :
  extension_of_max_adjoin hi f h y = extension_of_max hi f :=
extension_of_max_is_max hi f _ (extension_of_max_le hi f h)

lemma extension_of_max_to_submodule_eq_top (h : module.Baer R Q) :
  (extension_of_max hi f).to_submodule = ⊤ :=
begin
  by_contra rid,
  rcases show ∃ (y : N), y ∉ (extension_of_max hi f).to_submodule,
    by contrapose! rid; ext; exact ⟨λ _, trivial, λ _, rid _⟩ with ⟨y, hy⟩,
  apply hy,
  erw [← extension_of_max_eq hi f h y, submodule.mem_sup],
  exact ⟨0, submodule.zero_mem _, y, submodule.mem_span_singleton_self _, zero_add _⟩,
end

omit hi
theorem criterion (h : module.Baer R Q) :
  module.injective R Q :=
{ out := λ X Y ins1 ins2 ins3 ins4 i hi f, begin
  resetI,
  have eq1 := extension_of_max_to_submodule_eq_top hi f h,
  set f'' : (⊤ : submodule R Y) →ₗ[R] Q :=
  { to_fun := λ y, (extension_of_max hi f).extension ⟨y.1, eq1.symm ▸ y.2⟩,
    map_add' := λ x y, by { dsimp, rw ← map_add,  congr' 1 },
    map_smul' := λ r x, by { dsimp, rw ← linear_map.map_smul, congr' 1 } } with f''_eq,
  use
  { to_fun := λ y, f'' ⟨y, trivial⟩,
    map_add' := λ x y, by rw ← map_add; congr',
    map_smul' := λ r x, by rw [ring_hom.id_apply, ← linear_map.map_smul]; refl },
  intros x,
  exact ((extension_of_max hi f).is_extension x).symm,
end }

theorem criterion' (h : module.injective R Q) :
  module.Baer R Q :=
λ I g, begin
  replace h := h.out,
  replace h := @h (ulift I) (ulift R) _ _ _ _,
  set f' : ulift I →ₗ[R] ulift R :=
  { to_fun := λ x, ⟨x.down.1⟩,
    map_add' := λ x y, rfl,
    map_smul' := λ x y, rfl, },
  have f'_inj : function.injective f',
  { intros a b eq1,
    change ulift.up a.down.1 = ulift.up b.down.1 at eq1,
    rw ulift.ext_iff at eq1,
    dsimp only at eq1,
    rw [ulift.ext_iff, subtype.ext_iff_val, eq1], },
  set g' : ulift I →ₗ[R] Q :=
  { to_fun := λ x, g x.down,
    map_add' := λ x y, by { change g (x.down + y.down) = _, rw [map_add] },
    map_smul' := λ x y, by { change g (x • y.down) = _, rw [map_smul, ring_hom.id_apply], } },
  replace h := h f' f'_inj g',
  rcases h with ⟨h, eq1⟩,
  set h' : R →ₗ[R] Q :=
  { to_fun := λ x, h ⟨x⟩,
    map_add' := λ x y, by { change h (⟨x⟩ + ⟨y⟩) = _, rw map_add },
    map_smul' := λ x y, by { change h (x • ⟨y⟩) = _, rw [map_smul, ring_hom.id_apply] } },
  use h',
  intros x hx,
  change h ⟨x⟩ = _,
  specialize eq1 ⟨⟨x, hx⟩⟩,
  convert eq1,
end

end Baer


import ..primitives
open tv

namespace I
  def le (i1 i2 : I) := I.less_than_or_equal i1 i2
  def lt (i1 i2 : I) := I.less_than i1 i2
  @[refl] lemma le_refl (i : I) : i <= i := ⟨λ a, le_refl (i a)⟩
  @[trans] lemma le_trans {a b c : I} (h1 : a ≤ b) : b ≤ c → a ≤ c := λ h2, ⟨λ a, le_trans (h1.p a) (h2.p a)⟩
  lemma le_antisymm {n m : I} (h1 : n <= m) : m <= n -> n = m := λ h2, funext (λ a : atom, le_antisymm (h1.p a) (h2.p a))
  lemma lt_iff_le_not_le {a b : I} : a < b ↔ (a ≤ b ∧ ¬ b ≤ a) := iff.intro
    (λ l, begin
      split, exact l.p,
      by_contradiction p,
      cases l.q with w kk,
      exact ((lt_iff_le_not_le.mp kk).right) (p.p w) end)
    (λ r, begin
      split, exact r.left,
      exact I.not_lt_exists r.right,
    end)
  instance partial_order : partial_order I :=
  { le := le,
    lt := lt,
    le_refl := le_refl,
    le_trans := @le_trans,
    le_antisymm := @le_antisymm,
    lt_iff_le_not_le := @lt_iff_le_not_le }

  lemma le_top (i : I) : i <= I.top := I.less_than_or_equal.mk (λ a : atom, tv.le_top (i a))
  lemma bot_le (i : I) : I.less_than_or_equal I.bot i := I.less_than_or_equal.mk (λ a, tv.bot_le (i a))

  instance bounded_order : bounded_order I := {
    top := I.top,
    le_top := I.le_top,
    bot := I.bot,
    bot_le := I.bot_le,
  }

  instance has_sup : has_sup I := ⟨I.sup⟩
  @[simp] lemma sup_le (a b c : I) : a <= c -> b <= c -> a ⊔ b <= c := (λ h g, ⟨(λ x, max_le (h.p x) (g.p x))⟩)
  @[simp] lemma le_sup_right (a b : I) : b <= a ⊔ b := ⟨λ x, le_max_right (a x) (b x)⟩
  @[simp] lemma le_sup_left (a b : I) : a <= a ⊔ b  := ⟨λ x, le_max_left (a x) (b x)⟩

  instance has_inf : has_inf I := ⟨I.inf⟩
  @[simp] lemma le_inf (a b c : I) : a <= b -> a <= c -> a <= b ⊓ c := (λ h g, ⟨(λ x, le_min (h.p x) (g.p x))⟩)
  @[simp] lemma inf_le_right (a b : I) : a ⊓ b <= b:= ⟨λ x, min_le_right (a x) (b x)⟩
  @[simp] lemma inf_le_left (a b : I) : a ⊓ b <= a  := ⟨λ x, min_le_left (a x) (b x)⟩

  @[reducible]
  noncomputable instance has_Sup : has_Sup I := ⟨I.Sup⟩
  @[reducible]
  noncomputable instance has_Inf : has_Inf I := ⟨I.Inf⟩

  lemma le_Sup (S : set I) (i : I) (m : i ∈ S) : i <= (I.Sup S) := ⟨ λ a, begin
  let imager := (λ i : I, i a),
  let mapped_set := set.image imager S,
  have tv_le_Sup := tv.complete_lattice.le_Sup,
  have y := tv_le_Sup mapped_set (i a),
  have z : (i a) ∈ mapped_set := set.mem_image_of_mem imager m,
  exact y z,
  end⟩

  lemma Sup_le (S : set I) (i : I) (p : ∀ o ∈ S, o <= i) : (I.Sup S) <= i := ⟨ λ a, begin
  let imager := (λ i : I, i a),
  let mapped_set := set.image imager S,
  have tv_Sup_le := tv.complete_lattice.Sup_le,
  have y := tv_Sup_le mapped_set (i a),
  simp at y,
  exact y (λ j k, ((p j) k).p a),
  end⟩

  -- Proof is near identical to le_Sup
  lemma Inf_le (S : set I) (i : I) (m : i ∈ S) : (I.Inf S) <= i := ⟨ λ a, begin
  let imager := (λ i : I, i a),
  let mapped_set := set.image imager S,
  have tv_le_Sup := tv.complete_lattice.Inf_le,
  have y := tv_le_Sup mapped_set (i a),
  have z : (i a) ∈ mapped_set := set.mem_image_of_mem imager m,
  exact y z,
  end⟩

  -- Proof is near identical to Sup_le
  lemma le_Inf (S : set I) (i : I) (p : ∀ o ∈ S, i <= o) : i <= (I.Inf S) := ⟨ λ a, begin
  let imager := (λ i : I, i a),
  let mapped_set := set.image imager S,
  have tv_Sup_le := tv.complete_lattice.le_Inf,
  have y := tv_Sup_le mapped_set (i a),
  simp at y,
  exact y (λ j k, ((p j) k).p a),
  end⟩

  @[reducible] noncomputable instance complete_lattice : complete_lattice I := {
    le := I.le,
    sup := I.sup,
    sup_le := I.sup_le,
    le_sup_right := I.le_sup_right,
    le_sup_left := I.le_sup_left,
    inf := I.inf,
    le_inf := I.le_inf,
    inf_le_right := I.inf_le_right,
    inf_le_left := I.inf_le_left,
    Sup := I.Sup,
    le_Sup := I.le_Sup,
    Sup_le := I.Sup_le,
    Inf := I.Inf,
    le_Inf := I.le_Inf,
    Inf_le := I.Inf_le,
    ..I.partial_order,
    ..I.bounded_order,
  }
end I


import analysis.special_functions.trigonometric.deriv
import analysis.special_functions.log_deriv

namespace real

example : differentiable ℝ (λ (x : ℝ), exp x) :=
by simp

example : differentiable ℝ (λ (x : ℝ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℝ) : deriv (λ (x : ℝ), (cos x)^2 + 1 + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ (x : ℝ), (1+x)^3 - x^3 - 3 * x^2 - 3 * x - 4) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℝ) : differentiable_at ℝ (λ x, (cos x, x)) x := by simp

example (x : ℝ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℝ) : differentiable_at ℝ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℝ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

example (x : ℝ) (h : x ≠ 0) : deriv (λ x, x * (log x - 1)) x = log x :=
by simp [h]

end real

namespace complex

example : differentiable ℂ  (λ (x : ℂ), exp x) :=
by simp

example : differentiable ℂ (λ (x : ℂ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℂ) : deriv (λ (x : ℂ), (cos x)^2 + I + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℂ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℂ) : differentiable_at ℂ (λ x, (cos x, x)) x := by simp

example (x : ℂ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℂ) : differentiable_at ℂ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℂ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

end complex

namespace polynomial
open_locale polynomial

variables {R : Type*} [comm_semiring R]

example : (2 : R[X]).derivative = 0 :=
by conv_lhs { simp }

example : (3 + X : R[X]).derivative = 1 :=
by conv_lhs { simp }

example : (2 * X ^ 2 : R[X]).derivative = 4 * X :=
by conv_lhs { simp, ring_nf, }

example : (X ^ 2 : R[X]).derivative = 2 * X :=
by conv_lhs { simp }

example : ((C 2 * X ^ 3).derivative : R[X]) = 6 * X ^ 2 :=
by conv_lhs { simp, ring_nf, }

end polynomial


import linear_algebra.projective_space.basic
import data.fintype.card
import linear_algebra.linear_independent
import linear_algebra.finite_dimensional
import lemmas.matrix
import tactic

variables {K V : Type*}
  [field K]
  [add_comm_group V]
  [module K V]

namespace projectivization

inductive independent {ι : Type*} : (ι → ℙ K V) → Prop
| mk (f : ι → V) (hf : ∀ i, f i ≠ 0) (h : linear_independent K f) :
    independent (λ i : ι, projectivization.mk _ (f i) (hf i))

lemma independent_iff_rep {ι : Type*} (f : ι → ℙ K V) :
  independent f ↔
  linear_independent K (projectivization.rep ∘ f) :=
begin
  split,
  { rintro ⟨g,hg,h⟩,
    have : ∀ i, ∃ (a : Kˣ), a • g i = (mk K (g i) (hg i)).rep,
    { intro i, apply exists_smul_eq_mk_rep },
    choose e he using this,
    have : projectivization.rep ∘ (λ i, mk K (g i) (hg i)) = (λ i, e i • g i),
    { ext, rw he },
    rw this,
    exact linear_independent.units_smul h e },
  { intros h,
    have := independent.mk _ _ h,
    swap, { intros i, apply rep_nonzero },
    convert this,
    ext, simp only [mk_rep] }
end

inductive dependent {ι : Type*} : (ι → ℙ K V) → Prop
| mk (f : ι → V) (hf : ∀ i, f i ≠ 0) (h : ¬ linear_independent K f) :
    dependent (λ i : ι, projectivization.mk _ (f i) (hf i))

lemma dependent_iff_rep {ι : Type*} (f : ι → ℙ K V) :
  dependent f ↔
  ¬ linear_independent K (projectivization.rep ∘ f) :=
begin
  split,
  { rintro ⟨g,hg,h⟩,
    intro c, apply h,
    have : ∀ i, ∃ (a : Kˣ), a • g i = (mk K (g i) (hg i)).rep,
    { intro i, apply exists_smul_eq_mk_rep },
    choose e he using this,
    have : projectivization.rep ∘ (λ i, mk K (g i) (hg i)) = (λ i, e i • g i),
    { ext, rw he },
    rw this at c,
    convert linear_independent.units_smul c e⁻¹,
    ext, simp },
  { intros h,
    have := dependent.mk _ _ h,
    swap, { intros i, apply rep_nonzero },
    convert this,
    ext, simp only [mk_rep] }
end

@[simp]
lemma dependent_iff_not_independent { ι : Type*} (f : ι → ℙ K V) :
  ¬ independent f ↔ dependent f :=
by rw [independent_iff_rep, dependent_iff_rep]

@[simp]
lemma not_dependent_iff_independent {ι : Type*} (f : ι → ℙ K V) :
  ¬ dependent f ↔ independent f :=
by rw [← dependent_iff_not_independent, not_not]

lemma eq_iff_dependent (p q : ℙ K V) : p = q ↔ dependent ![p,q] :=
begin
  split,
  { rintro rfl, rw [dependent_iff_rep, fintype.linear_independent_iff],
    push_neg, use ![1,-1], refine ⟨by simp [fin.sum_univ_succ], 0, by simp⟩ },
  { intro h, rw [dependent_iff_rep, fintype.linear_independent_iff] at h,
    push_neg at h, obtain ⟨g,h1,i,h2⟩ := h,
    rw [← mk_rep p, ← mk_rep q, mk_eq_mk_iff],
    simp only [function.comp_app, fin.sum_univ_two, matrix.cons_val_zero,
      matrix.cons_val_one, matrix.head_cons] at h1,
    fin_cases i,
    { have : g 1 ≠ 0,
      { intro c, apply h2, simp only [c, zero_smul, add_zero, smul_eq_zero] at h1,
        cases h1, { exact h1, }, { exfalso, apply p.rep_nonzero h1 } },
      use (is_unit.mk0 _ h2).unit⁻¹ * -(is_unit.mk0 _ this).unit,
      rw [mul_smul, inv_smul_eq_iff, units.smul_def, units.smul_def],
      dsimp [is_unit.unit], rwa [neg_smul, neg_eq_iff_add_eq_zero, add_comm] },
    { have : g 0 ≠ 0,
      { intro c, apply h2, simp only [c, zero_smul, zero_add, smul_eq_zero] at h1,
        cases h1, { exact h1, }, { exfalso, apply q.rep_nonzero h1 } },
      use (is_unit.mk0 _ this).unit⁻¹ * -(is_unit.mk0 _ h2).unit,
      rw [mul_smul, inv_smul_eq_iff, units.smul_def, units.smul_def],
      dsimp [is_unit.unit], rwa [neg_smul, neg_eq_iff_add_eq_zero, add_comm] } }
end

lemma ne_iff_independent (p q : ℙ K V) : p ≠ q ↔ independent ![p,q] :=
by rw [← not_dependent_iff_independent, not_iff_not, eq_iff_dependent]

lemma dependent_iff_rep₃ (u v w : ℙ K V) : dependent ![u,v,w] ↔
  ∃ (a b c : K) (hh : ![a,b,c] ≠ 0), a • u.rep + b • v.rep + c • w.rep = 0 :=
begin
  split,
  { intro h,
    rw [dependent_iff_rep, fintype.linear_independent_iff] at h,
    push_neg at h,
    obtain ⟨g,h1,h2⟩ := h,
    use [g 0, g 1, g 2],
    refine ⟨_, by simpa [fin.sum_univ_succ, add_assoc] using h1⟩,
    intro c, obtain ⟨i,h2⟩ := h2, apply h2,
    convert congr_fun c i, fin_cases i; refl },
  { rintro ⟨a,b,c,h1,h2⟩,
    rw [dependent_iff_rep, fintype.linear_independent_iff],
    push_neg, use ![a,b,c],
    refine ⟨by simpa [fin.sum_univ_succ, add_assoc] using h2, _⟩,
    by_contra c, push_neg at c,
    apply h1, ext i, apply c }
end

lemma independent_mk_iff₃ (u v w : V) (hu : u ≠ 0) (hv : v ≠ 0) (hw : w ≠ 0) :
  independent ![mk K u hu, mk K v hv, mk K w hw] ↔
  linear_independent K ![u,v,w] :=
begin
  split,
  { intros h,
    rw independent_iff_rep at h,
    rw comp_matrix_eq_matrix₃ at h,
    choose e he using λ i : fin 3, exists_smul_eq_mk_rep K (![u,v,w] i)
      (by fin_cases i; assumption),
    have := h.units_smul e⁻¹,
    convert this,
    ext i,
    fin_cases i,
    { specialize he 0, dsimp at he, simp [← he] },
    { specialize he 1, simp only [matrix.cons_val_one, matrix.head_cons] at he, simp [← he], },
    { specialize he 2,
      simp only [matrix.cons_vec_bit0_eq_alt0, matrix.cons_append, matrix.empty_append,
        matrix.cons_vec_alt0, matrix.empty_vec_alt0,
        matrix.cons_val_one, matrix.head_cons] at he,
      simp [← he] } },
  { intro h, convert independent.mk _ _ h,
    { ext i, fin_cases i; simp },
    { intro i, fin_cases i; assumption } }
end

lemma independent_mk_iff₂ (u v : V) (hu : u ≠ 0) (hv : v ≠ 0) :
  independent ![mk K u hu, mk K v hv] ↔
  linear_independent K ![u,v] :=
begin
  split,
  { intros h,
    rw independent_iff_rep at h,
    rw comp_matrix_eq_matrix₂ at h,
    choose e he using λ i : fin 2, exists_smul_eq_mk_rep K (![u,v] i)
      (by fin_cases i; assumption),
    have := h.units_smul e⁻¹,
    convert this,
    ext i,
    fin_cases i,
    { specialize he 0, dsimp at he, simp [← he] },
    { specialize he 1, simp only [matrix.cons_val_one, matrix.head_cons] at he, simp [← he], } },
  { intro h, convert independent.mk _ _ h,
    { ext i, fin_cases i; simp },
    { intro i, fin_cases i; assumption } }
end

lemma dependent_mk_iff₃ (u v w : V) (hu : u ≠ 0) (hv : v ≠ 0) (hw : w ≠ 0) :
  dependent ![mk K u hu, mk K v hv, mk K w hw] ↔
  ¬ linear_independent K ![u,v,w] :=
by rw [← dependent_iff_not_independent, not_iff_not, independent_mk_iff₃]

lemma dependent_mk_iff₂ (u v : V) (hu : u ≠ 0) (hv : v ≠ 0) :
  dependent ![mk K u hu, mk K v hv] ↔
  ¬ linear_independent K ![u,v] :=
by rw [← dependent_iff_not_independent, not_iff_not, independent_mk_iff₂]

lemma independent_swap₃ (a b c : ℙ K V) :
  independent ![a,b,c] → independent ![a,c,b] :=
begin
  rintros h,
  rw [independent_iff_rep, fintype.linear_independent_iff] at *,
  intros g hg i,
  specialize h ![g 0, g 2, g 1] _,
  { simp only [fin.sum_univ_succ, function.comp_app, matrix.cons_val_zero, matrix.cons_val_succ,
      fintype.univ_of_subsingleton, fin.mk_zero, fin.succ_zero_eq_one, finset.sum_singleton,
      fin.succ_one_eq_two] at *,
    rwa add_comm (g 1 • _) at hg },
  fin_cases i, exacts [h 0, h 2, h 1],
end

lemma independent_rotate₃ (a b c : ℙ K V) :
  independent ![a,b,c] → independent ![b,c,a] :=
begin
  rintros h,
  rw [independent_iff_rep, fintype.linear_independent_iff] at *,
  intros g hg i,
  specialize h ![g 2, g 0, g 1] _,
  { simp only [fin.sum_univ_succ, function.comp_app, matrix.cons_val_zero, matrix.cons_val_succ,
      fintype.univ_of_subsingleton, fin.mk_zero, fin.succ_zero_eq_one, finset.sum_singleton,
      fin.succ_one_eq_two] at *,
    rwa [add_comm, add_assoc, add_comm, add_assoc] at hg, },
  fin_cases i, exacts [h 1, h 2, h 0],
end

lemma dependent_swap₃ (a b c : ℙ K V) :
  dependent ![a,b,c] → dependent ![a,c,b] :=
begin
  simp_rw ← dependent_iff_not_independent,
  rw not_imp_not,
  exact independent_swap₃ _ _ _,
end

lemma dependent_rotate₃ (a b c : ℙ K V) :
  dependent ![a,b,c] → dependent ![b,c,a] :=
begin
  simp_rw ← dependent_iff_not_independent,
  rw not_imp_not,
  intros h,
  apply independent_rotate₃,
  exact independent_rotate₃ _ _ _ h,
end

lemma independent_swap₂ (a b : ℙ K V) :
  independent ![a,b] → independent ![b,a] :=
begin
  simp only [← ne_iff_independent],
  intros h, exact h.symm
end

lemma dependent_swap₂ (a b : ℙ K V) :
  dependent ![a,b] → dependent ![b,a] :=
begin
  simp only [← eq_iff_dependent],
  intros h, exact h.symm,
end

def span₂ (a b : ℙ K V) : submodule K V :=
a.submodule ⊔ b.submodule

def span₃ (a b c : ℙ K V) : submodule K V :=
a.submodule ⊔ b.submodule ⊔ c.submodule

lemma span_eq_span₂ (a b : ℙ K V) :
  span₂ a b = submodule.span K ({a.rep, b.rep} : set V) :=
begin
  dsimp [span₂], simp only [submodule_eq],
  rw [sup_comm, ← submodule.span_union], simp,
end

lemma span_eq_span₃ (a b c : ℙ K V) :
  span₃ a b c = submodule.span K ({a.rep, b.rep, c.rep} : set V) :=
begin
  dsimp [span₃],
  rw [sup_comm, (sup_comm : a.submodule ⊔ _ = _), ← sup_assoc],
  simp only [submodule_eq, ← submodule.span_union, set.union_singleton],
end

lemma span_swap₃ (a b c : ℙ K V) :
  span₃ a b c = span₃ a c b :=
begin
  dsimp [span₃],
  simp only [sup_assoc],
  congr' 1, apply sup_comm,
end

lemma span_rotate₃ (a b c : ℙ K V ) :
  span₃ a b c = span₃ b c a :=
begin
  dsimp [span₃],
  rw [sup_assoc, sup_comm],
end

lemma span_swap₂ (a b : ℙ K V) :
  span₂ a b = span₂ b a :=
begin
  dsimp [span₂], rw sup_comm,
end

open finite_dimensional

section

variables [finite_dimensional K V]
open_locale classical

lemma finrank_span_of_independent₃ (a b c : ℙ K V) :
  independent ![a,b,c] → finrank K (span₃ a b c) = 3 :=
begin
  intros h, rw [independent_iff_rep] at h,
  rw [span_eq_span₃, ← set.range_matrix_eq₃, ← comp_matrix_eq_matrix₃],
  exact finrank_span_eq_card h,
end

lemma finrank_span_of_independent₂ (a b : ℙ K V) :
  independent ![a,b] → finrank K (span₂ a b) = 2 :=
begin
  intros h, rw [independent_iff_rep] at h,
  rw [span_eq_span₂, ← set.range_matrix_eq₂, ← comp_matrix_eq_matrix₂],
  exact finrank_span_eq_card h,
end

lemma finrank_span_lt_of_dependent₃ (a b c : ℙ K V) :
  dependent ![a,b,c] → finrank K (span₃ a b c) < 3 :=
begin
  intro h,
  rw dependent_iff_rep at h,
  rw [span_eq_span₃, ← set.range_matrix_eq₃, ← comp_matrix_eq_matrix₃],
  rw linear_independent_iff_card_eq_finrank_span at h,
  change ¬ (3 = _) at h,
  apply lt_of_le_of_ne,
  refine le_trans (finrank_span_le_card _) _,
  { simp only [set.to_finset_range],
    apply finset.card_image_le },
  exact ne.symm h,
end

instance nontrivial_span₂ (a b : ℙ K V) : nontrivial (span₂ a b) :=
begin
  use 0, use a.rep, apply submodule.mem_sup_left,
  rw submodule_eq, apply submodule.mem_span_singleton_self,
  intro c,
  apply a.rep_nonzero,
  exact congr_arg coe c.symm
end

instance nontrivial_span₃ (a b c : ℙ K V) : nontrivial (span₃ a b c) :=
begin
  use 0, use a.rep, dsimp [span₃], rw sup_assoc, apply submodule.mem_sup_left,
  rw submodule_eq, apply submodule.mem_span_singleton_self,
  intro c,
  apply a.rep_nonzero,
  exact congr_arg coe c.symm
end

lemma finrank_span_pos₃ (a b c : ℙ K V) :
  0 < finrank K (span₃ a b c) :=
finrank_pos

lemma fingrank_span_pos₂ (a b : ℙ K V) :
  0 < finrank K (span₂ a b) :=
finrank_pos

lemma span₂_le_span₃ (a b c : ℙ K V) :
  span₂ a b ≤ span₃ a b c :=
le_sup_left

lemma finrank_span_of_independent_of_dependent₃ (a b c : ℙ K V) :
  independent ![a,b] → dependent ![a,b,c] → finrank K (span₃ a b c) = 2 :=
begin
  intros h1 h2,
  have : finrank K (span₃ a b c) < 3 := finrank_span_lt_of_dependent₃ _ _ _ h2,
  have h : finrank K (span₂ a b) = 2 := finrank_span_of_independent₂ _ _ h1,
  have : 2 ≤ finrank K (span₃ a b c),
  { rw ← h,
    apply submodule.finrank_mono,
    exact le_sup_left },
  linarith
end

lemma dependent_iff_span (a b c : ℙ K V) (h : independent ![a,b]) :
  dependent ![a,b,c] ↔ c.submodule ≤ span₂ a b :=
begin
  split,
  { intros h,
    rw [dependent_iff_rep, fintype.not_linear_independent_iff] at h,
    rw [span_eq_span₂, submodule_eq],
    rw submodule.span_singleton_le_iff_mem,
    obtain ⟨g,h1,i,hi⟩ := h,
    simp only [fin.sum_univ_succ, function.comp_app, matrix.cons_val_zero, matrix.cons_val_succ,
      fin.succ_zero_eq_one, fintype.univ_of_subsingleton, fin.mk_zero, finset.sum_singleton,
      fin.succ_one_eq_two] at h1,
    have hh : g 2 ≠ 0,
    { intros c,
      rw [independent_iff_rep, fintype.linear_independent_iff] at h,
      specialize h ![g 0, g 1] (by simpa [c, fin.sum_univ_succ] using h1),
      apply hi,
      fin_cases i,
      exacts [h 0, h 1, c] },
    apply_fun (λ e, (g 2)⁻¹ • e) at h1,
    simp only [smul_add, smul_zero, ← mul_smul, inv_mul_cancel hh, one_smul,
      ← add_assoc, add_eq_zero_iff_neg_eq] at h1,
    rw ← h1,
    let E := submodule.span K ({a.rep, b.rep} : set V),
    apply E.neg_mem, apply E.add_mem; apply E.smul_mem; apply submodule.subset_span,
    { simp only [set.mem_insert_iff, eq_self_iff_true, true_or] },
    { simp only [set.mem_insert_iff, set.mem_singleton, or_true] } },
  { intro hh,
    dsimp [span₂] at hh, simp only [submodule_eq] at hh,
    rw [submodule.span_singleton_le_iff_mem, submodule.mem_sup] at hh,
    obtain ⟨u,hu,v,hv,hh⟩ := hh,
    simp only [submodule.mem_span_singleton] at hu hv,
    obtain ⟨i,rfl⟩ := hv,
    obtain ⟨j,rfl⟩ := hu,
    rw [dependent_iff_rep, fintype.not_linear_independent_iff],
    use ![j,i,-1],
    split,
    { simp only [fin.sum_univ_succ, function.comp_app, matrix.cons_val_zero, matrix.cons_val_succ,
        fintype.univ_of_subsingleton, matrix.cons_val_fin_one, neg_smul, one_smul,
        finset.sum_const, finset.card_singleton],
      simpa only [← add_assoc, add_neg_eq_zero] },
    { use 2, simp, } }
end

variables (K V)
structure configuration (a b c u v : ℙ K V) :=
(Iabc : independent ![a,b,c])
(Dabu : dependent ![a,b,u])
(Dacv : dependent ![a,c,v])
(Iau : independent ![a,u])
(Ibu : independent ![b,u])
(Iav : independent ![a,v])
(Icv : independent ![c,v])
variables {K V}

namespace configuration

variables {a b c u v : ℙ K V} (C : configuration K V a b c u v)

include C

lemma Icu : independent ![c,u] :=
begin
  rw ← ne_iff_independent,
  intro cc,
  have h1 := C.Iabc,
  have h2 := C.Dabu,
  rw cc at *,
  rw ← not_dependent_iff_independent at h1,
  apply h1, exact h2
end

lemma Ibv : independent ![b,v] :=
begin
  rw ← ne_iff_independent,
  intro cc,
  have h1 := independent_swap₃ _ _ _ C.Iabc,
  have h2 := C.Dacv,
  rw cc at *,
  rw ← not_dependent_iff_independent at h1,
  apply h1, exact h2
end

lemma Iab : independent ![a,b] :=
begin
  have := C.Iabc,
  simp only [independent_iff_rep, fintype.linear_independent_iff] at this ⊢,
  intros g hg i,
  specialize this ![g 0, g 1, 0] (by simpa [fin.sum_univ_succ] using hg),
  fin_cases i, exacts [this 0, this 1],
end

lemma Iac : independent ![a,c] :=
begin
  have := C.Iabc,
  simp only [independent_iff_rep, fintype.linear_independent_iff] at this ⊢,
  intros g hg i,
  specialize this ![g 0, 0, g 1] (by simpa [fin.sum_univ_succ] using hg),
  fin_cases i, exacts [this 0, this 2],
end

def M := span₃ a b c
def L₁ := span₂ u c
def L₂ := span₂ v b

lemma M_eq : C.M = C.L₁ ⊔ C.L₂ :=
begin
  dsimp [span₃, span₂, L₁, L₂, M],
  apply le_antisymm,
  { apply sup_le _ _; try { apply sup_le _ _ },
    rw [sup_comm, sup_assoc],
    apply le_trans _ le_sup_right,
    rw ← sup_assoc, apply le_trans _ le_sup_left,
    erw ← dependent_iff_span,
    apply dependent_rotate₃, exact C.Dabu, exact C.Ibu,
    apply le_trans le_sup_right le_sup_right,
    apply le_trans le_sup_right le_sup_left },
  { apply sup_le _ _; apply sup_le _ _,
    apply le_trans _ le_sup_left,
    erw ← dependent_iff_span, exact C.Dabu, exact C.Iab,
    exact le_sup_right,
    rw [(sup_comm : (a.submodule ⊔ _ = _)), sup_assoc],
    apply le_trans _ le_sup_right,
    erw ← dependent_iff_span, exact C.Dacv, exact C.Iac,
    apply le_trans le_sup_right le_sup_left },
end

lemma finrank_M : finrank K C.M = 3 :=
begin
  apply finrank_span_of_independent₃, exact C.Iabc,
end

lemma finrank_L₁ : finrank K C.L₁ = 2 :=
begin
  apply finrank_span_of_independent₂, apply independent_swap₂, exact C.Icu
end

lemma finrank_L₂ : finrank K C.L₂ = 2 :=
begin
  apply finrank_span_of_independent₂, apply independent_swap₂, exact C.Ibv
end

def Q := C.L₁ ⊓ C.L₂

lemma finrank_Q : finrank K C.Q = 1 :=
begin
  have := submodule.dim_sup_add_dim_inf_eq C.L₁ C.L₂,
  dsimp [Q],
  rw [← C.M_eq, C.finrank_M, C.finrank_L₁, C.finrank_L₂] at this,
  linarith,
end

end configuration

theorem exists_unique_of_configuration (a b c u v : ℙ K V)
  (C : configuration K V a b c u v) :
  ∃! q : ℙ K V, dependent ![u,c,q] ∧ dependent ![v,b,q] :=
begin
  use mk'' C.Q C.finrank_Q,
  refine ⟨⟨_,_⟩,_⟩,
  { erw dependent_iff_span, simp only [submodule_mk''],
    refine le_trans inf_le_left (le_of_eq rfl),
    apply independent_swap₂,
    exact C.Icu },
  { erw dependent_iff_span, simp only [submodule_mk''],
    refine le_trans inf_le_right (le_of_eq rfl),
    apply independent_swap₂,
    exact C.Ibv },
  { intros y hy,
    rw ← mk''_submodule y, congr' 1,
    apply eq_of_le_of_finrank_eq,
    { apply le_inf _ _,
      { erw ← dependent_iff_span, exact hy.1,
        apply independent_swap₂, exact C.Icu },
      { erw ← dependent_iff_span, exact hy.2,
        apply independent_swap₂, exact C.Ibv } },
    { rw [finrank_submodule, C.finrank_Q] } }
end

lemma eq_of_config (a b c u v q₁ q₂ : ℙ K V)
  (C : configuration K V a b c u v) :
  dependent ![u,c,q₁] →
  dependent ![v,b,q₁] →
  dependent ![u,c,q₂] →
  dependent ![v,b,q₂] → q₁ = q₂ :=
begin
  obtain ⟨q,h1,h2⟩ := exists_unique_of_configuration _ _ _ _ _ C,
  intros e1 e2 e3 e4,
  have eq1 : q₁ = q,
  { apply h2, exact ⟨e1,e2⟩ },
  have eq2 : q₂ = q,
  { apply h2, exact ⟨e3,e4⟩ },
  rw [eq1, ← eq2],
end

end
section

/-! incidence is preserved by linear equivalences. TODO: generalize -/

variables {W : Type*} [add_comm_group W] [module K W]
variable (E : V ≃ₗ[K] W)

lemma map_mk_eq_mk' (E : V →ₗ[K] W) (hE : function.injective E)
  (u : V) (hu : u ≠ 0) :
  map E hE (mk K u hu) = mk _ (E u) (by { rw ← E.map_zero, exact hE.ne hu }) := rfl

lemma map_mk_eq_mk (u : V) (hu : u ≠ 0) :
  map E.to_linear_map E.injective (mk K u hu) =
  mk _ (E u) (E.map_ne_zero_iff.mpr hu) :=
rfl

lemma independent_map_comp_of_independent {ι : Type*}
  (e : ι → ℙ K V) :
  independent e → independent (map E.to_linear_map E.injective ∘ e) :=
begin
  intro h, induction h with f hf h,
  refine independent.mk _ _ (h.map (_ : disjoint _ E.to_linear_map.ker)),
  convert disjoint_bot_right,
  rw linear_map.ker_eq_bot, exact E.injective
end

lemma independent_map_comp_iff {ι : Type*}
  (e : ι → ℙ K V) :
  independent e ↔ independent (map E.to_linear_map E.injective ∘ e) :=
begin
  refine ⟨independent_map_comp_of_independent _ _, _⟩,
  intros h,
  convert independent_map_comp_of_independent E.symm _ h,
  ext, rw [← function.comp.assoc, ← map_comp],
  dsimp,
  change id (e x) = _, apply congr_fun, symmetry, convert map_id,
  ext, simp,
end

lemma independent_iff_independent₂ (u v : ℙ K V) :
  independent ![u,v] ↔
  independent ![map E.to_linear_map E.injective u, map E.to_linear_map E.injective v] :=
by rw [independent_map_comp_iff E, comp_matrix_eq_matrix₂]

lemma independent_iff_independent₃ (u v w : ℙ K V) :
  independent ![u, v, w] ↔
  independent ![map E.to_linear_map E.injective u,
    map E.to_linear_map E.injective v,
    map E.to_linear_map E.injective w] :=
by rw [independent_map_comp_iff E, comp_matrix_eq_matrix₃]

lemma dependent_map_comp_iff {ι : Type*}
  (e : ι → ℙ K V) :
  dependent e ↔ dependent (map E.to_linear_map E.injective ∘ e) :=
begin
  simp only [← dependent_iff_not_independent, not_iff_not],
  apply independent_map_comp_iff,
end

lemma dependent_iff_dependent₂ (u v : ℙ K V) :
  dependent ![u,v] ↔
  dependent ![map E.to_linear_map E.injective u, map E.to_linear_map E.injective v] :=
by rw [dependent_map_comp_iff E, comp_matrix_eq_matrix₂]

lemma dependent_iff_dependent₃ (u v w : ℙ K V) :
  dependent ![u, v, w] ↔
  dependent ![map E.to_linear_map E.injective u,
    map E.to_linear_map E.injective v,
    map E.to_linear_map E.injective w] :=
by rw [dependent_map_comp_iff E, comp_matrix_eq_matrix₃]

end

end projectivization


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Patrick Massot
-/
import topology.algebra.ordered
import data.set.intervals.proj_Icc

/-!
# Projection onto a closed interval

In this file we prove that the projection `set.proj_Icc f a b h` is a quotient map, and use it
to show that `Icc_extend h f` is continuous if and only if `f` is continuous.
-/

variables {α β : Type*} [topological_space α] [linear_order α] [order_topology α]
  [topological_space β] {a b : α} {h : a ≤ b}

open set

@[continuity]
lemma continuous_proj_Icc : continuous (proj_Icc a b h) :=
continuous_subtype_mk _ $ continuous_const.max $ continuous_const.min continuous_id

lemma quotient_map_proj_Icc : quotient_map (proj_Icc a b h) :=
quotient_map_iff.2 ⟨proj_Icc_surjective h, λ s,
  ⟨λ hs, hs.preimage continuous_proj_Icc,
   λ hs, ⟨_, hs, by { ext, simp }⟩⟩⟩

@[simp] lemma continuous_Icc_extend_iff {f : Icc a b → β} :
  continuous (Icc_extend h f) ↔ continuous f :=
quotient_map_proj_Icc.continuous_iff.symm

@[continuity]
lemma continuous.Icc_extend {f : Icc a b → β} (hf : continuous f) :
  continuous (Icc_extend h f) :=
hf.comp continuous_proj_Icc


def f (x y z : Nat) : Nat :=
  match x, y, z with
  | 5, _, _ => y
  | _, 5, _ => y
  | _, _, 5 => y
  | _, _, _ => 1

example (x y z : Nat) : x ≠ 5 → y ≠ 5 → z ≠ 5 → f x y z = 1 := by
  intros
  simp [f]
  split
  . contradiction
  . contradiction
  . contradiction
  . rfl

example (x y z : Nat) : f x y z = y ∨ f x y z = 1 := by
  intros
  simp [f]
  split
  . exact Or.inl rfl
  . exact Or.inl rfl
  . exact Or.inl rfl
  . exact Or.inr rfl

example (x y z : Nat) : f x y z = y ∨ f x y z = 1 := by
  intros
  simp [f]
  split <;> (first | apply Or.inl rfl | apply Or.inr rfl)

def g (xs ys : List Nat) : Nat :=
  match xs, ys with
  | [a, b], _ => Nat.succ (a+b)
  | _, [b, c] => Nat.succ b
  | _, _   => 1

example (xs ys : List Nat) : g xs ys > 0 := by
  simp [g]
  split
  next a b _    => show Nat.succ (a + b) > 0; apply Nat.zero_lt_succ
  next xs b c _ => show Nat.succ b > 0; apply Nat.zero_lt_succ
  next => decide