import algebra.homology.homological_complex
import algebra.homology.single
import category_theory.abelian.basic

import for_mathlib.split_exact
import for_mathlib.derived.defs
import for_mathlib.has_homology

noncomputable theory

open category_theory category_theory.limits

namespace cochain_complex

variables {𝓐 : Type*} [category 𝓐] [abelian 𝓐]
variables (C : cochain_complex 𝓐 ℤ)

open_locale zero_object

/--
Given a cochain complex
```
C^{n-2} → C^{n-1} → C^n → C^{n+1}
```
`imker C n` should be the cochain complex
```
   0  → Im(d^{n-1}) → Ker(d^n) → 0
```
supported in degrees n-1 and n (note that both terms are naturally subobjects
of C^n). As a result, `H_i(imker C n) = 0` for all `i≠n`, and `= H_i(C)` for `i=n`.
-/
def imker (C : cochain_complex 𝓐 ℤ) (n : ℤ) : cochain_complex 𝓐 ℤ :=
{ X := λ i, if i = n-1
      then image (C.d_to n)
      else if i = n
        then kernel (C.d_from n)
        else 0,
  d := λ i j, if hi : i = n - 1
      then if hj : j = n
        -- modulo eq_to_iso this is just the `image_to_kernel` map.
        then (eq_to_iso (by rw [hi, if_pos rfl]) : (_ : 𝓐) ≅ image (C.d_to n)).hom ≫
          image_to_kernel' _ _ (homological_complex.d_to_comp_d_from _ n) ≫
          (eq_to_iso begin rw [if_neg, if_pos hj], linarith, end).hom
        else 0
      else 0,
  shape' := begin
    rintro i j (h : _ ≠ _),
    split_ifs with hi,
    { rw dif_neg,
      rintro rfl,
      exact (h (add_eq_of_eq_sub hi)).elim, },
    { refl },
  end,
  d_comp_d' := begin
    rintro i j k (rfl : _ = _) (rfl : _ = _),
    split_ifs with hi hn,
    { subst hi,
      simp only [add_right_eq_self, one_ne_zero, not_false_iff, dif_neg, comp_zero]},
    { apply zero_comp, },
  end }

namespace imker

open homological_complex (single)

lemma X_def {n i : ℤ} : (imker C n).X i = if i = n-1
  then image (C.d_to n)
  else if i = n
    then kernel (C.d_from n)
    else 0 :=
rfl

@[simps] def X_iso_image (n : ℤ) : (imker C n).X (n-1) ≅ image (C.d_to n) :=
eq_to_iso (by {rw [X_def, if_pos rfl]})

@[simps] def X_iso_image_of_eq {n i : ℤ} (h : i = n - 1) :
  (imker C n).X i ≅ image (C.d_to n) :=
eq_to_iso (by {rw [X_def, if_pos h]})

@[simps]
def X_iso_image' (n : ℤ) :
(C.imker (n + 1)).X n ≅ image (C.d n (n + 1)) :=
(eq_to_iso (by simp)) ≪≫ (X_iso_image C (n + 1)) ≪≫ image_iso_of_eq (C.d_to_eq rfl) ≪≫ image.is_iso_comp _

@[simps] def X_iso_kernel (n : ℤ) : (imker C n).X n ≅ kernel (C.d_from n) :=
eq_to_iso (by {rw [X_def, if_neg, if_pos rfl], linarith})

@[simps] def X_iso_kernel_of_eq {n i : ℤ} (h : i = n) :
  (imker C n).X i ≅ kernel (C.d_from n) :=
eq_to_iso (by {rw [X_def, if_neg, if_pos h], linarith})

@[simps] def kernel_iso_X_of_eq {n i : ℤ} (h : i = n) :
  (kernel (C.d_from n) : 𝓐) ≅ (imker C n).X i :=
eq_to_iso (by {rw [X_def, if_neg, if_pos h], linarith})

lemma X_is_zero_of_ne {i j : ℤ} (h1 : j ≠ i - 1) (h2 : j ≠ i) : is_zero ((C.imker i).X j) :=
begin
  rw [X_def, if_neg h1, if_neg h2],
  exact is_zero_zero 𝓐,
end

@[simp] lemma d_def {n i j : ℤ} : (imker C n).d i j = if hi : i = n - 1
  then if hj : j = n
    then (eq_to_iso (by rw [hi, if_pos rfl]) :
      ((if i = n-1 then image (C.d_to n) else if i = n then kernel
        (C.d_from n) else 0) : 𝓐) ≅ image (C.d_to n)).hom ≫
      image_to_kernel' _ _ (homological_complex.d_to_comp_d_from _ n) ≫
      (eq_to_iso begin dsimp only [imker], rw [if_neg, if_pos hj], linarith, end :
        (kernel (C.d_from n) : 𝓐) ≅ _).hom
    else 0
  else 0 :=
rfl

lemma d_eq_im_to_ker {n i j : ℤ} (h : i = n - 1) (hj : j = n) : (imker C n).d i j =
(X_iso_image_of_eq C h).hom ≫
image_to_kernel' _ _ (homological_complex.d_to_comp_d_from _ n) ≫ (X_iso_kernel_of_eq _ hj).inv :=
begin
  simp only [h, hj, eq_self_iff_true, d_def, eq_to_iso.hom, dif_pos, X_iso_image_of_eq_hom,
    X_iso_kernel_of_eq_inv],
  refl,
end

lemma d_from_eq_zero {n i : ℤ} (h : i ≠ n - 1) : (C.imker n).d_from i = 0 :=
begin
  rw [homological_complex.d_from_eq (C.imker n) rfl, d_def, dif_neg h, zero_comp],
end

lemma bounded_by (i : ℤ) :
  ((homotopy_category.quotient _ _).obj (C.imker i)).bounded_by (i+1) :=
begin
  intros j hj,
  simp only [homotopy_category.quotient_obj_as],
  apply X_is_zero_of_ne;
  linarith,
end

instance is_bounded_above (i : ℤ) :
  ((homotopy_category.quotient _ _).obj (C.imker i)).is_bounded_above :=
⟨⟨i+1, bounded_by C i⟩⟩

/-- The natural map from `imker C n` to `H_n(C)[n]`, the complex consisting of the n'th
homology of C supported in degree n. -/
def to_single (n : ℤ) : C.imker n ⟶ (single _ _ n).obj (C.homology n) :=
{ f := λ i,
  if h : i = n
    then (X_iso_kernel_of_eq C h).hom ≫
      cokernel.π (image_to_kernel' _ _ (homological_complex.d_to_comp_d_from _ n)) ≫
      (homology_iso_cokernel_image_to_kernel' _ _ _).inv ≫
      (homological_complex.single_obj_X_self 𝓐 (complex_shape.up ℤ) n _).inv ≫
      eq_to_hom (by rw h)
    else 0,
  comm' := begin
   rintro i j (rfl : _ = _),
   simp only [homological_complex.single_obj_X_self_inv, eq_to_iso.hom, eq_to_hom_trans,
     homological_complex.single_obj_d, comp_zero],
   split_ifs with hi hn,
   { subst hi, clear hn,
     rw d_eq_im_to_ker C (show i = i + 1 - 1, by ring) rfl,
     simp only [category.assoc, iso.inv_hom_id_assoc, cokernel.condition_assoc, zero_comp,
       comp_zero], },
   { exact (hn rfl).elim },
   { rw comp_zero },
  end }

-- move
lemma _root_.homological_complex.single_obj_is_zero (V : Type*) [_inst_1 : category V]
  [_inst_2 : has_zero_morphisms V] [_inst_3 : has_zero_object V] {ι : Type*}
  [_inst_4 : decidable_eq ι] (c : complex_shape ι) {i j : ι} (h : i ≠ j) (A : V) :
  is_zero (((single V c j).obj A).X i) :=
begin
  change is_zero (ite (i = j) A 0),
  rw if_neg h,
  exact is_zero_zero V,
end

-- move
def _root_.homological_complex.single_obj_iso_zero (V : Type*) [_inst_1 : category V]
  [_inst_2 : has_zero_morphisms V] [_inst_3 : has_zero_object V] {ι : Type*}
  [_inst_4 : decidable_eq ι] (c : complex_shape ι) {i j : ι} (h : i ≠ j) (A : V) :
  ((single V c j).obj A).X i ≅ 0 :=
is_zero.iso_zero (homological_complex.single_obj_is_zero _ _ h _)

-- why does `homology_zero_zero` need a zero object?
-- move
lemma homology_is_zero_of_is_zero {V : Type*} [category V] [has_zero_morphisms V] {A B C : V}
  (hB : is_zero B) {f : A ⟶ B} {g : B ⟶ C} [has_kernels V] [has_images V] [has_cokernels V]
  [has_zero_object V] -- ??
  (w : f ≫ g = 0) : is_zero (homology f g w) :=
begin
  simp_rw is_zero.eq_zero_of_tgt hB f,
  simp_rw is_zero.eq_zero_of_src hB g,
  exact is_zero_of_iso_of_zero hB (homology_zero_zero.symm),
end

-- variant of homology_zero_zero
-- move
def homology_zero_zero' {V : Type*} [category V] [abelian V]
  {A B C : V} {f : A ⟶ B} {g : B ⟶ C} (hf : f = 0) (hg : g = 0) :
  homology f g (by simp [hf]) ≅ B :=
(eq_to_iso (show homology f g _ = homology (0 : A ⟶ B) (0 : B ⟶ C) (by simp), by simp [hf, hg]))
  ≪≫ homology_zero_zero

-- move
lemma is_iso_cokernel_pi_image_to_kernel_of_zero_of_zero {V : Type*} [category V]
  [abelian V] {A B C : V} {f : A ⟶ B} {g : B ⟶ C} (hf : f = 0) (hg : g = 0) :
is_iso (cokernel.π (image_to_kernel f g (by simp [hf]))) :=
begin
  subst hf,
  subst hg,
  rw image_to_kernel_zero_left,
  apply cokernel.π_of_zero,
end

-- move
lemma cokernel.desc_spec {V : Type*} [category V]
  [abelian V] {A B C : V} {f : A ⟶ B} {g : B ⟶ C} (w : f ≫ g = 0)
  (c : cokernel f ⟶ C) : (cokernel.π f ≫ c = g) ↔ c = cokernel.desc f g w :=
begin
  have h2 := cokernel.π_desc f g w,
  split,
  { rintro rfl,
    symmetry,
    rwa cancel_epi at h2, },
  { rintro rfl,
    assumption },
end

-- move
lemma cokernel.desc_comp_left {V : Type*} [category V]
  [abelian V] {A B C D : V} {f : A ⟶ B} {g : B ⟶ C} {e : C ⟶ D} (w : f ≫ g = 0) :
  (cokernel.desc f g w) ≫ e =
  (cokernel.desc f (g ≫ e) (by rw [← category.assoc, w, zero_comp])) :=
begin
  rw ← cokernel.desc_spec,
  simp [cokernel.π_desc],
end

-- move
lemma is_iso_cokernel.desc {V : Type*} [category V] [abelian V] {A B C : V} {f : A ⟶ B} {g : B ⟶ C}
  (h : exact f g) (h2 : epi g) : is_iso (cokernel.desc f g h.1) :=
is_iso_of_op (cokernel.desc f g h.w)

-- move
lemma sq_from_epi_of_epi {ι : Type*} {V : Type*} [_inst_1 : category V] [_inst_2 : abelian V]
  {c : complex_shape ι}
  {C₁ C₂ : homological_complex V c} (φ : C₁.hom C₂) (i : ι)
  (h2 : is_zero (C₂.X_next i)) [epi (φ.f i)] :
epi (homological_complex.hom.sq_from φ i) :=
⟨begin
  rintros ψ ⟨fL, fR, fw⟩ ⟨gL, gR, gw⟩,
  intro h,
  congr',
  { apply_fun category_theory.comma_morphism.left at h,
    simp at h,
    rwa cancel_epi at h, },
  { dsimp at fR gR,
    have fR0 : fR = 0 := is_zero.eq_zero_of_src h2 _,
    subst fR0,
    have gR0 : gR = 0 := is_zero.eq_zero_of_src h2 _,
    subst gR0, },
end⟩

-- move
lemma kernel_subobject_map_epi_of_epi {C : Type*} [_inst_1 : category C] [abelian C] {X Y : C}
  {f : X ⟶ Y} (hY : is_zero Y)
   {X' Y' : C} {f' : X' ⟶ Y'} (hY' : is_zero Y')
    (φ : arrow.mk f ⟶ arrow.mk f') [epi φ.left] : epi (kernel_subobject_map φ) :=
begin
  have hf : f = 0 := is_zero.eq_zero_of_tgt hY _,
  have hf' : f' = 0 := is_zero.eq_zero_of_tgt hY' _,
  haveI hfiso : is_iso (kernel_subobject f).arrow,
  { rw [← kernel_subobject_arrow, hf],
    simp,
    apply_instance },
  haveI hf'iso : is_iso (kernel_subobject f').arrow,
  { rw [← kernel_subobject_arrow, hf'],
    simp,
    apply_instance },
  suffices : epi (kernel_subobject_map φ ≫ (kernel_subobject f').arrow),
  { rwa epi_is_iso_comp_iff_epi at this },
  rw kernel_subobject_map_arrow,
  simp,
  apply_instance,
end

-- move
lemma image_to_kernel_epi_of_epi {V : Type*} [category V] [abelian V]
  {A B C : V} (f : A ⟶ B) (g : B ⟶ C) [epi f] (w : f ≫ g = 0) :
  epi (image_to_kernel f g w) :=
begin
  have claim0 := image_subobject_arrow_comp f,
  have claim : (image_subobject f).arrow = (image_to_kernel f g w) ≫ (kernel_subobject g).arrow,
  { exact (image_to_kernel_arrow f g w).symm},
  have claim2 := factor_thru_image_subobject_comp_image_to_kernel _ _ w,
  suffices : epi (factor_thru_kernel_subobject g f w),
  { rw ← claim2 at this,
    resetI,
    apply epi_of_epi (factor_thru_image_subobject f) (image_to_kernel f g w), },
  apply epi_of_epi_of_comp_epi_of_mono _ (kernel_subobject g).arrow,
  rw factor_thru_kernel_subobject_comp_arrow g f w,
  apply_instance,
end

-- move
lemma image_to_kernel_zero_left' {V : Type*} [category V] [has_zero_morphisms V]
  {A B C : V} {f : A ⟶ B} (hf : f = 0) (g : B ⟶ C) [has_kernels V]
  [has_zero_object V] [has_image f] :
image_to_kernel f g (by rw [hf, zero_comp]) = 0 :=
begin
  convert image_to_kernel_zero_left g,
  rw zero_comp,
end

-- move
lemma cokernel.desc_is_iso {A B C D : 𝓐} (f : A ⟶ B) (g : B ⟶ C) (e : C ⟶ D) [is_iso e]
  (w : f ≫ g = 0) : cokernel.desc f g w ≫ e = cokernel.desc f (g ≫ e)
  (begin rw [← category.assoc, w, zero_comp] end) :=
begin
  rw ← cancel_epi (cokernel.π f),
  simp,
end

-- move
lemma image_to_kernel_eq_image_to_kernel_of_eq_snd {A B C : 𝓐} (f : A ⟶ B) {g h : B ⟶ C}
  (hgh : g = h) (w : f ≫ g = 0) : image_to_kernel f g w = image_to_kernel f h (by rw [← hgh, w]) ≫
  eq_to_hom (by rw hgh) :=
begin
  subst hgh,
  simp only [eq_to_hom_refl, category.comp_id],
end

-- move
lemma image_to_kernel_eq_image_to_kernel_of_eq_fst {A B C : 𝓐} (f g : A ⟶ B) {h : B ⟶ C}
  (hfg : f = g) (w : f ≫ h = 0) : image_to_kernel f h w = eq_to_hom (by rw hfg) ≫
    image_to_kernel g h (by rw [← hfg, w]) :=
begin
  subst hfg,
  simp only [eq_to_hom_refl, category.id_comp],
end

-- lemma cokernel.desc_with_isomorphisms {A B C D : 𝓐} (f : A ⟶ B) (e : B ⟶ C) (g : C ⟶ D)
--   [is_iso e] (w : f ≫ e ≫ g = 0) :
--   (cokernel_comp_is_iso f e).hom ≫ cokernel.desc f (e ≫ g) w =
--   cokernel.desc (f ≫ e) g (by simp [w]) :=
-- begin
--   simp,
--   admit, -- presumably this is true!
-- end

-- move to `single`
lemma single.d_eq_zero (V : Type*) [category V] [has_zero_morphisms V] [has_zero_object V]
  {ι : Type*} [decidable_eq ι] (c : complex_shape ι) (i j k : ι) ( v : V) :
  ((single V c i).obj v).d j k = 0 := rfl

-- move to `single`
lemma single.d_from_eq_zero (V : Type*) [category V] [has_zero_morphisms V] [has_zero_object V]
  {ι : Type*} [decidable_eq ι] (c : complex_shape ι) (i j : ι) ( v : V) :
  ((single V c i).obj v).d_from j = 0 :=
single.d_eq_zero _ _ _ _ _ _

-- move to `single`
lemma single.d_to_eq_zero (V : Type*) [category V] [has_zero_morphisms V] [has_zero_object V]
  {ι : Type*} [decidable_eq ι] (c : complex_shape ι) (i j : ι) ( v : V) :
  ((single V c i).obj v).d_to j = 0 :=
single.d_eq_zero _ _ _ _ _ _

-- this is preparation for `imker.map_is_iso` which follows.
lemma homology_functor.is_iso_of_is_zero_of_is_zero_of_is_zero {ι : Type*} {c : complex_shape ι}
  {i j : ι} (hij : c.rel i j) {C₁ C₂ : homological_complex 𝓐 c} (h1from : C₁.d_from j = 0)
  (h2to : C₂.d_to j = 0) (h2from : C₂.d_from j = 0) (isomap : cokernel (C₁.d_to j) ≅ C₂.X j)
  {f : C₁ ⟶ C₂} (hf : f.f j = cokernel.π (C₁.d_to j) ≫ isomap.hom) :
is_iso ((homology_functor 𝓐 c j).map f) :=
begin
  rw [homology_functor_map],
  let h₁ : has_homology (C₁.d_to j) (C₁.d_from j) (cokernel (C₁.d_to j)) := has_homology.snd_eq_zero' h1from,
  let h₂ : has_homology (C₂.d_to j) (C₂.d_from j) (C₂.X j) := has_homology.fst_snd_eq_zero' h2to h2from,
  have := has_homology.map_iso_homology_map h₁ h₂
    (commsq.of_eq (homological_complex.hom.comm_to f j)).symm
    (commsq.of_eq (homological_complex.hom.comm_from f j)).symm,
  rw ← is_iso_iff_is_iso_comp_left ((h₁.iso (homology.has (C₁.d_to j) (C₁.d_from j) _)).hom),
    swap, apply_instance,
  rw ← is_iso_iff_is_iso_comp_right ((h₂.iso (homology.has (C₂.d_to j) (C₂.d_from j) _)).inv),
    swap, apply_instance,
  suffices h2 : is_iso (h₁.map h₂ (commsq.of_eq _).symm (commsq.of_eq _).symm),
  { rw this at h2, convert h2 using 1, simp, congr, },
  convert_to is_iso (isomap.hom), swap, apply_instance,
  simp only [h₁, h₂, has_homology.map, has_homology.snd_eq_zero', has_homology.fst_snd_eq_zero', has_homology.desc,
    has_homology.lift, hf, category.assoc],
  symmetry,
  apply exact.epi_desc_unique,
  apply exact.mono_lift_unique,
  simp only [category.assoc],
end

/-- `to_single C n` induces an isomorphism of cohomology in degree `n`. -/
lemma map_is_iso (n : ℤ) : is_iso
  (homology.map (homological_complex.d_to_comp_d_from _ _)
    (homological_complex.d_to_comp_d_from _ _) (homological_complex.hom.sq_to (to_single C n) n)
    (homological_complex.hom.sq_from (to_single C n) n) rfl) :=
begin
/-
image_subobject (C.d_to) -> kernel_subobject (C.d_from) -> 0
 |
 \⧸
 0                       -> C.homology n                -> 0

-/
  change is_iso ((homology_functor 𝓐 (complex_shape.up ℤ) n).map (to_single C n)),
  refine homology_functor.is_iso_of_is_zero_of_is_zero_of_is_zero _ _ _ _ _ _,
  { exact (n-1)},
  { show _ = _, by ring},
  { rw d_from_eq_zero, linarith },
  { rw single.d_to_eq_zero, },
  { rw single.d_from_eq_zero, },
  { refine _ ≪≫ (homological_complex.single_obj_X_self _ _ _ _).symm,
    refine cokernel_iso_of_eq (homological_complex.d_to_eq (C.imker n) (show (n - 1) + 1 = n, by ring)) ≪≫ _,
    refine (cokernel_epi_comp _ _) ≪≫ _,
    refine cokernel_iso_of_eq (d_eq_im_to_ker _ rfl rfl) ≪≫ _,
    refine (cokernel_epi_comp _ _) ≪≫ _,
    refine (cokernel_comp_is_iso _ _) ≪≫ _,
    exact (homology_iso_cokernel_image_to_kernel' _ _ _).symm,
    },
  { delta to_single,
    dsimp, simp },
end

instance to_single_quasi_iso (n : ℤ) :
  homotopy_category.is_quasi_iso $ (homotopy_category.quotient _ _).map (to_single C n) :=
⟨begin
  intro i,
  -- split into cases : the n'th map, and all the other maps,
  rcases eq_or_ne i n with (rfl | hin),
  { -- The n'th map is the nontrivial case.
    -- First there's this quotient map to the homotopy category which we replace by `homology_functor`.
    rw ← functor.comp_map,
    apply map_is_iso_of_iso_of_map_is_iso (homotopy_category.homology_factors 𝓐
      (complex_shape.up ℤ) i).symm,
      /- The goal now states that the middle arrow induces an isomorphism
         on homology of the below complexes:

         im d -> ker d -> 0
          |       |       |
          \/      \⧸      \/
           0  -> ker/im-> 0

      But we just proved this in `map_is_iso`.
      -/

    apply map_is_iso, },
  -- For the "boring" cases (where we're asserting 0 ≅ 0) we deal with degree n-1 separately.
  { rcases eq_or_ne i (n-1) with (rfl | hin'),
    -- degree n-1
    { rw ← functor.comp_map,
      apply map_is_iso_of_iso_of_map_is_iso (homotopy_category.homology_factors 𝓐
        (complex_shape.up ℤ) (n-1)).symm,
      apply is_iso_of_is_zero_of_is_zero,
      { apply @is_zero_cokernel_of_epi _ _ _ _ _ _ _,
        have foo : homological_complex.d_to (C.imker n) (n - 1) = 0,
        { apply is_zero.eq_zero_of_src,
          have := homological_complex.X_prev_iso (C.imker n) (show (n-2)+1 = (n-1), by ring),
          apply is_zero_of_iso_of_zero _ this.symm,
          apply X_is_zero_of_ne;
          linarith },
        haveI : mono (homological_complex.d_from (C.imker n) (n - 1)),
        { rw homological_complex.d_from_eq (C.imker n) (show (n-1)+1=n, by ring),
          rw d_eq_im_to_ker _ rfl rfl,
          delta image_to_kernel', -- should register the instance that image_to_kernel' is mono!
          apply_instance },
        convert image_to_kernel_epi_of_zero_of_mono (homological_complex.d_from (C.imker n) (n - 1)),
      },
      { rw ← functor.comp_obj,
        apply obj_is_zero_of_iso (homotopy_category.homology_factors 𝓐 (complex_shape.up ℤ) (n-1)).symm,
        rw homology_functor_obj,
        apply homology_is_zero_of_is_zero,
        dsimp only,
        rw if_neg hin,
        apply is_zero_zero,
      }, },
    -- other degrees
    { apply is_iso_of_is_zero_of_is_zero,
      { rw ← functor.comp_obj,
        apply obj_is_zero_of_iso (homotopy_category.homology_factors 𝓐 (complex_shape.up ℤ) i).symm,
        rw homology_functor_obj,
        have hC := X_is_zero_of_ne C hin' hin,
        refine is_zero_of_iso_of_zero hC _,
        delta homological_complex.homology,
        symmetry,
        convert homology_zero_zero,
        apply is_zero.eq_zero_of_tgt hC,
        apply is_zero.eq_zero_of_src hC,
        all_goals {apply_instance},
      },
      { rw ← functor.comp_obj,
        apply obj_is_zero_of_iso (homotopy_category.homology_factors 𝓐 (complex_shape.up ℤ) i).symm,
        rw homology_functor_obj,
        apply homology_is_zero_of_is_zero,
        apply homological_complex.single_obj_is_zero _ _ hin,
      }
    }
  }
end⟩

end imker

end cochain_complex


import .dual

universes u v

--def supermatroid.maximizable {α : Type u} [preorder α] (s : set α) : Prop :=
--  ∀ (a ∈ s) b, a ≤ b → (maximals (≤) ((set.Icc a b) ∩ s)).nonempty

--def supermatroid.augmentable {α : Type u} [semilattice_sup α] (s : set α) : Prop :=
--  ∀ (a ∈ s) b, (a ∉ maximals (≤) s) → (b ∈ maximals (≤) s) → ((set.Ioc a (a ⊔ b)) ∩ s).nonempty

variables {α : Type u} [lattice α] [bounded_order α] {M : supermatroid α}
  {i j b x y c d r : α}

open set supermatroid

@[ext] structure supermatroid' (α : Type u) [semilattice_sup α] :=
(indep         : α → Prop)
(ind_nonempty  : ∃ x, indep x )
(ind_lower_set : is_lower_set indep)
(le_basis_sup  : ∀ i b, indep i → (maximals (≤) indep) b →
  ∃ b', (maximals (≤) indep) b' ∧ i ≤ b' ∧ b' ≤ i ⊔ b)
(ind_maximize' : ∀ x, (maximals (≤) ((Iic x) ∩ indep)).nonempty)

def supermatroid'_of (M : supermatroid α) : supermatroid' α := {
  indep         := M.indep,
  ind_nonempty  := M.ind_nonempty,
  ind_lower_set := M.ind_lower_set,
  le_basis_sup  := λ i b hi hb, hi.le_basis_sup hb,
  ind_maximize' := λ x, by {
    obtain ⟨i,hi⟩ := M.exists_basis_of x,
    exact ⟨i,⟨hi.le,hi.indep⟩,λ j hj hij, hi.eq_of_le_indep hij hj.1 hj.2⟩}}

lemma aug' (M : supermatroid' α): augmentable M.indep :=
begin
  intros i his b hi_nb hb,
  obtain ⟨b',h₁,h₂,h₃⟩ := M.le_basis_sup i b his hb,
  exact ⟨b', ⟨lt_of_le_of_ne' h₂ (λ h, hi_nb (h ▸ h₁)), h₃⟩, h₁.1⟩,
end


/-
Copyright (c) 2021 Huub Vromen. All rights reserved.
Author: Huub Vromen
-/

import modal_logic_multi_agent

variable {indiv : Type}
variable {f : m_frame indiv}
variables {s t u v : f.wo}
variables {A φ ψ γ : f.wo → Prop}
variables i j i1 i2 : indiv

/- Sillari's theory has to represent the two central concepts of Lewis' theory
   of common knowledge. The first one, reason to believe, is captured by the
   operator R that is defined in the file modal_logic_multi_agent.
   The second one, indication, is defined as follows. -/

/-- Indication is defined in terms of Reason-to-believe and implication -/
def Ind (i : indiv) (φ : f.wo → Prop) (ψ : f.wo → Prop) : f.wo → Prop :=
  λw, R i φ w ∧ (φ w → ψ w)

/-- this property expresses that a frame has at least three worlds -/
def three_worlds : f.wo → f.wo → f.wo → Prop :=
  λw1 w2 w3, w2 ≠ w1 ∧ w2 ≠ w3 ∧ w3 ≠ w1

/-- this property expresses that a frame has at least two worlds -/
def two_worlds : f.wo → f.wo → Prop :=
  λw1 w2, w1 ≠ w2

/-- this property expresses that there are exactly two individuals -/
def two_agents : indiv → indiv → Prop :=
  λi1 i2, i1 ≠ i2 ∧ ∀i, i = i1 ∨ i = i2

/-- this property expresses that there is exactly one individual -/
def one_agent : indiv → Prop :=
  λi1, ∀i, i = i1

/-- Sillari mixes a proof-theoretic account with eleven axioms B1 - B8 and
    B10 - B11 and a semantic account with his modal definitions of R and Ind.
    We prove that all but three of the axioms can be derived as lemmas from the
    definitions of R and Ind.
    Axiom B3 contradicts the definitions: we provide a counterexample.
    Axioms B7 and B8 will not be discussed because they play no role in Sillari's
    argument. -/

lemma  B1 : ∀w, R i φ w → R i (φ →ₘ ψ) w → R i ψ w :=
begin
intros v h1 h2 u h3,
rw R at *,
have h4 : φ u, from h1 u h3,
have h5 : (φ →ₘ ψ) u, from h2 u h3,
exact h5 h4,
end

lemma B2 : ∀w, R i φ w → (φ →ₘ ψ) w → Ind i φ ψ w :=
begin
intros w h1 h2,
rw Ind,
split,
{ assumption  },
{ intro h3,
  rw m_imp at h2,
  exact h2 h3 }
end

/-- Lemma B3 states: ∀w, R r i φ w → Ind r i φ ψ w → R r i ψ w.
    This is not true, as we will show by a counterexample, a model with two worlds.
    that is problematic for Sillari because he needs this axiom in his proof of
    Lewis' theorem.
    B3 is the same as Lewis' A1 -/

lemma B3_fails
(h1 : two_worlds s t)
(h2a : ¬ f.r i s s) (h2b : f.r i s t):
    ¬ (∀w (φ ψ : f.wo → Prop), R i φ w → Ind i φ ψ w → R i ψ w) :=
begin
let ψ := λw : f.wo, w ≠ t,
let φ := λw : f.wo, w ≠ s,
push_neg,
have h4 : R i φ s := by tidy,
have h5 : Ind i φ ψ s := by tidy,
have h6 : ¬ R i ψ s := by simp [R]; exact h2b,
use [s, φ, ψ],
exact and.intro h4 (and.intro h5 h6),
end

lemma B4 : ∀w, Ind i φ γ w → Ind i γ ψ w → Ind i φ ψ w :=
begin
intros w h1 h2,
rw Ind at *,
split,
{ exact h1.1 },
{ have h4 : φ w → γ w, from h1.2,
  have h5 : γ w → ψ w, from h2.2,
  intro hw,
  exact h5 (h4 hw)  }
end

lemma B5 : (⊢ φ) → (⊢ (φ →ₘ ψ)) → (⊢ ψ) :=
begin
intros h1 h2,
rw m_valid at *,
intro w,
exact h2 w (h1 w)
end

lemma B6 {i : indiv} : (⊢ φ) → (⊢ R i φ) :=
begin
intros h1 u,
rw R,
intros v hv,
exact h1 v
end

/-- Sillari also states axioms B7 (positive introspection) and B8 (negative
    introspection), but he does not use these axioms, and they do not follow from
    the semantics.
    Axiom B7 : ⊢ (R r i φ →ₘ R r i (R r i φ))
    Axiom B8 : ⊢ (R r i φ →ₘ ¬ₘ (R r i (¬ₘ φ))
    These axioms would imply that the relations of the frame are transitive and
    serial. -/

lemma B10 : ⊢ CRg φ →ₘ Rg (φ ∧ₘ CRg φ) :=
begin
intros w h1,
have h2 : CRg φ w ↔ Rg (φ ∧ₘ CRg φ) w := fixed_point_theorem φ w,
exact iff.elim_left h2 h1,
end

lemma B11 : (⊢ φ →ₘ Rg (φ ∧ₘ ψ)) → (⊢ (φ →ₘ CRg ψ)) := induction_rule φ ψ

/-- Cubitt and Sugden's axiom C4 fails. This proves that Sillari's formalisation does not match
    the account of common knowledge that Lewis gave. -/

lemma C4_fails (h1 : two_worlds s t) (h2a : ¬ f.r i s s) (h2b : f.r i s t) :
    ¬ ∀w (φ ψ : f.wo → Prop), (Ind i φ ψ w → R i (Ind j φ ψ) w) :=
begin
let φ := λw : f.wo, true,
let ψ := λw : f.wo, w = s,
push_neg,
have h3 : Ind i φ ψ s := by tidy,
have h3a : ¬ R i (Ind j φ ψ) s :=
  begin
  simp [R, Ind],
  use t,
  --simp [two_worlds] at h1,
  have h3b : ¬ ψ t := by finish,
  exact and.intro h2b h3b,
  end,
use [s, φ, ψ],
finish,
end

/- Now we discuss Sillari's proof of Lewis' theorem. It is not clear how to
   interpret his proof. Therefore, two options are presented. The first option makes
   it impossible to find a proof. The second option gives a valid proof, but
   the proof is trivial and thus useless. -/

/-- option 1 : C1 - C3 are only assumed at the world for which the theorem has to
    hold. First, we provide a counterexample with one agent and a frame with three
    worlds. In this counterexample, the frame is nor transitive nor serial. -/

lemma Lewis_fails_1i
(h1 : three_worlds s u v)
(h2 : one_agent i1)
(h3 : f.r = λi1 w1 w2, (w1 = s ∧ w2 = u) ∨ (w1 = u ∧ w2 = v))
: ¬ ∀ i (φ ψ : f.wo → Prop), R i1 φ s → Ind i (R i1 φ) (R i1 (R i1 φ)) s → Ind i1 (R i1 φ) (R i1 ψ) s → CRg ψ s :=
begin
let φ := λw, w ≠ s,
let ψ := λw, w = u,
push_neg,
use [i1, φ, ψ],
rw three_worlds at h1,
rw one_agent at h2,
have h4 : R i1 φ s :=
  begin
    rw R,
    intros w hw,
    have h4a : w = u := by finish,
    rw h4a,
    have h4b : u ≠ s := h1.1,
    assumption,
  end,
have h5 : R i1 (R i1 φ) s :=
  begin
  rw R,
  intros w hw,
  rw R,
  intros x hx,
  have h5a : w = u := by finish,
  have h5b : x = v := by finish,
  have h5c : v ≠ s := (h1.2).2,
  rw h5b,
  assumption,
  end,
have h6 : Ind i1 (R i1 φ) (R i1 (R i1 φ)) s :=
  begin
    rw Ind,
    simp *,
  end,
have h7 : Ind i1 (R i1 φ) (R i1 ψ) s :=
  begin
  rw Ind,
  --simp *,
  --rw R,
  --intros w hw,
  finish,
  end,
have h8 : ¬ CRg ψ s :=
  begin
    rw CRg,
    push_neg,
    use v,
    split,
    { have h8a : connected s u :=
        begin
          rw connected,
          use i1,
          finish,
        end,
      have h8b : connected u v :=
      begin
          rw connected,
          use i1,
          finish,
        end,
      exact trcl.trans h8a (trcl.base h8b) },
    { intro h8c,
      have h8d : u ≠ v := (h1.2).1,
      show false, from h8d (eq.symm h8c)   },
  end,
finish,
end

/-- In case we accept axioms B7 and B8, we have to provide a counterexample with a
    frame that is transitive and serial. That is possible: -/
lemma Lewis_fails_2i
(h1 : three_worlds s u v)
(h2 : two_agents i1 i2)
(h3 : f.r = λi w1 w2, (i = i1 ∧ w1 = s ∧ w2 = u) ∨ (i = i1 ∧ w1 = u ∧ w2 = u)
∨ (w1 = v ∧ w2 = v) ∨ (i = i2 ∧ w1 = s ∧ w2 = s) ∨ (i = i2 ∧ w1 = u ∧ w2 = v))
: ¬ ∀ i (φ ψ : f.wo → Prop), Rg φ s → Ind i (Rg φ) (Rg (Rg φ)) s → Ind i (Rg φ) (Rg ψ) s → CRg ψ s :=
begin
rw two_agents at h2,
rw three_worlds at h1,
let φ := λw, true,
let ψ := λw, w ≠ v,
push_neg,
use [i1, φ, ψ],
have h4 : Rg φ s :=
  begin
    rw Rg,
    intro i,
    have h4a : i = i1 ∨ i = i2 := h2.right i,
    --rw R,
    cases' h4a; finish,
  end,
have h43 : Rg (Rg φ) s :=
  begin
  rw Rg,
  intro i,
  have h4a : i = i1 ∨ i = i2 := h2.right i,
  cases' h4a; finish,
  end,
have h5 : Ind i1 (Rg φ) (Rg (Rg φ)) s :=
  begin
    rw Ind,
    split,
    { exact h43 i1  },
    { intro h; exact h43},
  end,
have h6 : Ind i1 (Rg φ) (Rg ψ) s :=
  begin
  rw Ind,
  split,
  { exact h43 i1 },
  { simp [h4],
    rw Rg,
    intro i,
    have h4a : i = i1 ∨ i = i2 := h2.right i,
    cases' h4a,
      repeat { rw h,
        rw R,
        simp *,
        finish, },
  },
  end,
have h7 : ¬ CRg ψ s :=
  begin
  rw CRg,
  push_neg,
  use v,
  simp,
  have h7a : connected s u :=
        begin
          rw connected,
          use i1,
          finish,
        end,
      have h7b : connected u v :=
      begin
          rw connected,
          use i2,
          finish,
        end,
      exact trcl.trans h7a (trcl.base h7b),
  end,
finish,
end

/-- option 2 : C1 - C3 are assumed to hold at each world
    Now, the proof is rather trivial -/
lemma lewis_s_2
(C1 : ∀w, Rg φ w)
(C2 : ∀w, Ind i (Rg φ) (Rg (Rg φ)) w)
(C3 : ∀w, Ind i (Rg φ) (Rg ψ) w) :
  CRg ψ s :=
begin
intros v hv,
induction' hv with s u ih,
{   have h4 : Rg ψ s := (C3 s).2 (C1 s),
    cases ih with j ihh,
    exact (h4 j) u ihh  },
{   exact ih i C1 C2 C3   },
end


import data.pnat.basic

/-! # IMO 2013 N1 -/

namespace IMOSL
namespace IMO2013N1

/-- Final solution -/
theorem final_solution (f : ℕ+ → ℕ+) : (∀ m n : ℕ+, m ^ 2 + f n ∣ m * f m + n) ↔ f = (λ n, n) :=
begin
  simp only [pow_succ, pow_zero, mul_one],
  symmetry; split,
  rintros rfl m n; exact dvd_refl _,
  intros h; funext n; apply le_antisymm,

  ---- `f(n) ≤ n`
  { replace h := h (f n) n,
    rw ← mul_add_one at h,
    replace h := dvd_trans (dvd_mul_right _ _) h,
    rw [pnat.dvd_iff, pnat.add_coe, pnat.mul_coe, nat.dvd_add_right ⟨_, rfl⟩, ← pnat.dvd_iff] at h,
    exact pnat.le_of_dvd h },

  ---- `f(n) ≥ n`
  { rcases eq_or_ne n 1 with rfl | h0,
    exact (f 1).one_le,
    replace h := pnat.le_of_dvd (h n n),
    generalize_hyp : f n = m at h ⊢; clear f,
    replace h0 := pnat.exists_eq_succ_of_ne_one h0,
    rcases h0 with ⟨k, rfl⟩,
    rwa [add_one_mul, add_right_comm, add_le_add_iff_right,
         add_one_mul, add_le_add_iff_right, mul_le_mul_iff_left] at h }
end

end IMO2013N1
end IMOSL


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.pi.basic
import Mathlib.category_theory.limits.limits
import Mathlib.PostPort

universes u₁ v₁

namespace Mathlib

/-!
# Limits in the category of indexed families of objects.

Given a functor `F : J ⥤ Π i, C i` into a category of indexed families,
1. we can assemble a collection of cones over `F ⋙ pi.eval C i` into a cone over `F`
2. if all those cones are limit cones, the assembled cone is a limit cone, and
3. if we have limits for each of `F ⋙ pi.eval C i`, we can produce a
   `has_limit F` instance
-/

namespace category_theory.pi

/--
A cone over `F : J ⥤ Π i, C i` has as its components cones over each of the `F ⋙ pi.eval C i`.
-/
def cone_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} (c : limits.cone F) (i : I) : limits.cone (F ⋙ eval C i) :=
  limits.cone.mk (limits.cone.X c i) (nat_trans.mk fun (j : J) => nat_trans.app (limits.cone.π c) j i)

/--
A cocone over `F : J ⥤ Π i, C i` has as its components cocones over each of the `F ⋙ pi.eval C i`.
-/
def cocone_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} (c : limits.cocone F) (i : I) : limits.cocone (F ⋙ eval C i) :=
  limits.cocone.mk (limits.cocone.X c i) (nat_trans.mk fun (j : J) => nat_trans.app (limits.cocone.ι c) j i)

/--
Given a family of cones over the `F ⋙ pi.eval C i`, we can assemble these together as a `cone F`.
-/
def cone_of_cone_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} (c : (i : I) → limits.cone (F ⋙ eval C i)) : limits.cone F :=
  limits.cone.mk (fun (i : I) => limits.cone.X (c i))
    (nat_trans.mk fun (j : J) (i : I) => nat_trans.app (limits.cone.π (c i)) j)

/--
Given a family of cocones over the `F ⋙ pi.eval C i`, we can assemble these together as a `cocone F`.
-/
def cocone_of_cocone_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} (c : (i : I) → limits.cocone (F ⋙ eval C i)) : limits.cocone F :=
  limits.cocone.mk (fun (i : I) => limits.cocone.X (c i))
    (nat_trans.mk fun (j : J) (i : I) => nat_trans.app (limits.cocone.ι (c i)) j)

/--
Given a family of limit cones over the `F ⋙ pi.eval C i`,
assembling them together as a `cone F` produces a limit cone.
-/
def cone_of_cone_eval_is_limit {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} {c : (i : I) → limits.cone (F ⋙ eval C i)} (P : (i : I) → limits.is_limit (c i)) : limits.is_limit (cone_of_cone_comp_eval c) :=
  limits.is_limit.mk fun (s : limits.cone F) (i : I) => limits.is_limit.lift (P i) (cone_comp_eval s i)

/--
Given a family of colimit cocones over the `F ⋙ pi.eval C i`,
assembling them together as a `cocone F` produces a colimit cocone.
-/
def cocone_of_cocone_eval_is_colimit {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} {c : (i : I) → limits.cocone (F ⋙ eval C i)} (P : (i : I) → limits.is_colimit (c i)) : limits.is_colimit (cocone_of_cocone_comp_eval c) :=
  limits.is_colimit.mk fun (s : limits.cocone F) (i : I) => limits.is_colimit.desc (P i) (cocone_comp_eval s i)

/--
If we have a functor `F : J ⥤ Π i, C i` into a category of indexed families,
and we have limits for each of the `F ⋙ pi.eval C i`,
then `F` has a limit.
-/
theorem has_limit_of_has_limit_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} [∀ (i : I), limits.has_limit (F ⋙ eval C i)] : limits.has_limit F :=
  limits.has_limit.mk
    (limits.limit_cone.mk (cone_of_cone_comp_eval fun (i : I) => limits.limit.cone (F ⋙ eval (fun (i : I) => C i) i))
      (cone_of_cone_eval_is_limit fun (i : I) => limits.limit.is_limit (F ⋙ eval (fun (i : I) => C i) i)))

/--
If we have a functor `F : J ⥤ Π i, C i` into a category of indexed families,
and colimits exist for each of the `F ⋙ pi.eval C i`,
there is a colimit for `F`.
-/
theorem has_colimit_of_has_colimit_comp_eval {I : Type v₁} {C : I → Type u₁} [(i : I) → category (C i)] {J : Type v₁} [small_category J] {F : J ⥤ ((i : I) → C i)} [∀ (i : I), limits.has_colimit (F ⋙ eval C i)] : limits.has_colimit F := sorry