import topology.sheaves.sheaf
import algebra.category.Group.limits
import oc
import data.nat.parity
import new.unordered.C
import lemmas.about_opens
import lemmas.lemmas

noncomputable theory

section

open topological_space Top Top.sheaf
open category_theory
open opposite

universe u
variables {X : Top.{u}} (𝓕 : sheaf Ab X) (U : X.oc)

structure vec_o (n : ℕ) : Type u :=
(to_fun : fin n → U.ι)
(is_strict_mono : strict_mono to_fun)

def vec_o.zero : vec_o U 0 :=
{ to_fun := λ ⟨i, hi⟩, by linarith,
  is_strict_mono := λ ⟨i, hi⟩ _ _, by linarith }

@[ext] lemma vec_o_ext {n : ℕ} {α β : vec_o U n} (h1 : α.to_fun = β.to_fun) :
  α = β :=
begin
  cases α,
  cases β,
  dsimp at *,
  subst h1,
end

lemma vec_o.zero_uniq (α : vec_o U 0) :
  α = vec_o.zero _ :=
begin
  ext j,
  rcases j with ⟨j, hj⟩,
  linarith
end

instance (n : ℕ) : has_coe_to_fun (vec_o U n) (λ _, fin n → U.ι) :=
{ coe := λ α, α.to_fun }

instance (n : ℕ) : has_coe (vec_o U n) (fin n → U.ι) :=
{ coe := λ α, α.to_fun }

def C_o.pre (n : ℕ) : Type u :=
Π (α : vec_o U n), 𝓕.1.obj (op $ face α)

section

variables {𝓕 U}
lemma map_congr.vec_o_eq {n} (f : C_o.pre 𝓕 U n) {α β : vec_o U n} (EQ : α = β) :
  f α = 𝓕.1.map (eq_to_hom $ by rw EQ).op (f β) :=
begin
  subst EQ,
  rw [eq_to_hom_op, eq_to_hom_map, eq_to_hom_refl, id_apply],
end

end

namespace C_o_pre

variable (n : ℕ)
variables {𝓕 U}

instance : has_add (C_o.pre 𝓕 U n) :=
{ add := λ f g α, f α + g α }

lemma add_assoc (f g h : C_o.pre 𝓕 U n) :
  f + g + h = f + (g + h) :=
begin
  ext α,
  simp [pi.add_apply, add_assoc],
end

lemma add_comm (f g : C_o.pre 𝓕 U n) :
  f + g = g + f :=
funext $ λ _, by simp [add_comm]

instance : has_zero (C_o.pre 𝓕 U n) :=
{ zero := λ α, 0 }

lemma zero_add (f : C_o.pre 𝓕 U n) :
  0 + f = f :=
funext $ λ α, by simp

lemma add_zero (f : C_o.pre 𝓕 U n) :
  f + 0 = f :=
funext $ λ _, by simp

instance (α : Type*) [Π (O : opens X), has_scalar α (𝓕.1.obj (op O))] :
  has_scalar α (C_o.pre 𝓕 U n) :=
{ smul := λ m f β, m • (f β) }

lemma nsmul_zero (f : C_o.pre 𝓕 U n):
  0 • f = 0 :=
funext $ λ _, by simp

lemma zsmul_zero (f : C_o.pre 𝓕 U n) :
  (0 : ℤ) • f = 0 :=
funext $ λ _, by simp

lemma nsmul_succ (m : ℕ) (f : C_o.pre 𝓕 U n)  :
  m.succ • f = f + m • f :=
funext $ λ α, by simp [add_nsmul, nat.succ_eq_add_one, _root_.add_comm]

lemma zsmul_succ (m : ℕ) (f : C_o.pre 𝓕 U n)  :
  int.of_nat (m.succ) • f = f + int.of_nat m • f :=
funext $ λ α, by simp [add_smul, _root_.add_comm]

instance : has_neg (C_o.pre 𝓕 U n) :=
{ neg := λ f α, - f α }

lemma add_left_neg (f : C_o.pre 𝓕 U n) :
  (-f) + f = 0 :=
funext $ λ _, by simp

instance : has_sub (C_o.pre 𝓕 U n) :=
{ sub := λ f g α, f α - g α }

lemma sub_eq_add_neg (f g : C_o.pre 𝓕 U n) :
  f - g = f + (- g) :=
funext $ λ α,
calc  (f - g) α
    = f α - g α : rfl
... = f α + (- g α) : by abel

end C_o_pre

instance (n : ℕ) : add_comm_group (C_o.pre 𝓕 U n) :=
{ add := (+),
  add_assoc := C_o_pre.add_assoc n,
  zero := 0,
  zero_add := C_o_pre.zero_add n,
  add_zero := C_o_pre.add_zero n,
  nsmul := (•),
  nsmul_zero' := C_o_pre.nsmul_zero n,
  nsmul_succ' := C_o_pre.nsmul_succ n,
  neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := C_o_pre.sub_eq_add_neg n,
  zsmul := (•),
  zsmul_zero' := C_o_pre.zsmul_zero n,
  zsmul_succ' := C_o_pre.zsmul_succ n,
  zsmul_neg' := λ m f, funext $ λ α, by simp [add_smul],
  add_left_neg := C_o_pre.add_left_neg n,
  add_comm := C_o_pre.add_comm n }

def C_o (n : ℕ) : Ab := AddCommGroup.of (C_o.pre 𝓕 U n)

section ignore_o

variable (n : ℕ)
variables {U 𝓕 n}

def ignore_o (α : vec_o U (n + 1)) (k : fin (n + 1)) : vec_o U n :=
{ to_fun := ignore α.to_fun k,
  is_strict_mono := λ i j h, begin
    by_cases ineq1 : j.1 < k.1,
    { rw ignore.apply_lt,
      work_on_goal 2
      { transitivity j.1,
        exact h,
        exact ineq1, },
      rw ignore.apply_lt,
      work_on_goal 2
      { assumption, },
      apply α.2,
      exact h },
    -- rw not_lt at ineq1,

    { rw ignore.apply_not_lt α.1 _ ineq1,
      rw not_lt at ineq1,
      rw ignore.apply_ite,
      split_ifs with ineq2,
      { apply α.2,
        change i.1 < j.1.pred,
        sorry },
      { apply α.2,
        change i.1.pred < j.1.pred,
        sorry }, },
  end }

def ignore_o₂ (α : vec_o U (n + 2)) (i : fin (n + 2)) (j : fin (n + 1)) :
  vec_o U n :=
ignore_o (ignore_o α i) j

lemma ignore_o₂_symm' {n : ℕ} (α : vec_o U (n+2))
  {i : ℕ} (hi : i ∈ finset.range n.succ)
  {j : ℕ} (hj : j ∈ finset.Ico i n.succ) : -- i ≤ j
  ignore_o₂ α ⟨j + 1, begin
    rw finset.mem_Ico at hj,
    rw nat.succ_lt_succ_iff,
    exact hj.2
  end⟩ ⟨i, finset.mem_range.mp hi⟩ = ignore_o₂ α ⟨i, lt_trans (finset.mem_range.mp hi) (lt_add_one _)⟩ ⟨j, (finset.mem_Ico.mp hj).2⟩ :=
begin
  sorry
end

lemma ignore_o.apply_lt (α : vec_o U (n + 1)) (k : fin (n + 1)) (i : fin n)
  (ineq : i.1 < k.1) :
  ignore_o α k i = α ⟨i.1, lt_trans i.2 (lt_add_one _)⟩ :=
begin
  change ignore α.to_fun k i = α.1 _,
  rw ignore.apply_lt,
  exact ineq
end

lemma ignore_o.apply_not_lt (α : vec_o U (n + 1)) (k : fin (n + 1)) (i : fin n)
  (ineq : ¬ i.1 < k.1) :
  ignore_o α k i = α ⟨i.1.pred, begin
    rw nat.lt_succ_iff,
    refine le_of_lt _,
    exact lt_of_le_of_lt (nat.pred_le _) i.2,
  end⟩ :=
begin
  change ignore α.to_fun k i = α.1 _,
  rw ignore.apply_not_lt,
  exact ineq,
end

def face_o (α : vec_o U n) : opens X :=
infi (λ (k : fin n), U.cover $ α k)

lemma face.le_ignore_o (α : vec_o U (n + 1)) (k : fin (n + 1)) :
  face_o α ≤ face_o (ignore_o α k) := λ p hp,
begin
  rw opens.mem_coe at hp ⊢,
  erw opens.fintype_infi at hp ⊢,
  rintros ⟨i, hi⟩,
  by_cases ineq : i < k.1,
  { specialize hp ⟨i, _⟩,
    { refine lt_trans hi _,
      exact lt_add_one n, },
    rw ignore_o.apply_lt,
    swap, exact ineq,
    exact hp, },
  { specialize hp ⟨i.pred, _⟩,
    { rw nat.lt_succ_iff,
      by_cases i = 0,
      { subst h,
        exact nat.zero_le _, },
      refine le_of_lt _,
      refine lt_trans _ hi,
      exact nat.pred_lt h, },
    rw ignore_o.apply_not_lt,
    convert hp,
    exact ineq, }
end

lemma face.le_ignore_o₂ (α : vec_o U (n + 2)) (i : fin (n + 2)) (j : fin (n + 1)) :
  face_o α ≤ face_o (ignore_o₂ α i j) :=
le_trans (face.le_ignore_o _ i) (face.le_ignore_o _ _)

lemma face.vec_o_zero :
  face (vec_o.zero U) = ⊤ :=
begin
  rw eq_top_iff,
  rintros p -,
  erw [opens.mem_coe, opens.fintype_infi],
  rintros ⟨j, hj⟩,
  linarith,
end

end ignore_o

def C_o.zeroth :
  C_o 𝓕 U 0 ≅ 𝓕.1.obj (op ⊤) :=
{ hom :=
  { to_fun := λ f, 𝓕.1.map (eq_to_hom (face.vec_o_zero).symm).op $ f (vec_o.zero U),
    map_zero' := begin
      rw [pi.zero_apply, map_zero],
    end,
    map_add' := λ f g, begin
      rw [pi.add_apply, map_add],
    end },
  inv :=
  { to_fun := λ s α, 𝓕.1.map (hom_of_le $ le_top).op s,
    map_zero' := begin
      ext α,
      rw [map_zero, pi.zero_apply],
    end,
    map_add' := λ f g, begin
      ext α,
      rw [pi.add_apply, map_add],
    end },
  hom_inv_id' := begin
    ext f α,
    change (𝓕.1.map _ ≫ 𝓕.1.map _) _ = _,
    simp only [id_apply],
    rw map_congr.vec_o_eq f (vec_o.zero_uniq U α),
    rw ← 𝓕.1.map_comp,
    congr,
  end,
  inv_hom_id' := begin
    ext f,
    change (𝓕.1.map _ ≫ 𝓕.1.map _) _ = _,
    rw [id_apply, ← 𝓕.1.map_comp],
    have : 𝓕.val.map (𝟙 (op ⊤)) f = f,
    { rw 𝓕.1.map_id,
      rw id_apply, },
    convert this,
  end }

section d_o

open nat
open_locale big_operators

variable (n : ℕ)
variables {𝓕 U n}

def d_o.to_fun.component' (α : vec_o U (n + 1)) (k : fin (n + 1)) (f : C_o.pre 𝓕 U n)  :
  𝓕.1.obj (op (face α)) :=
(ite (even k.1) id (has_neg.neg)) $
  𝓕.1.map (hom_of_le $ face.le_ignore α k).op $ f (ignore_o α k)

def d_o.to_fun.component (k : fin (n + 1)) :
  C_o.pre 𝓕 U n → C_o.pre 𝓕 U (n + 1) :=
λ f α, d_o.to_fun.component' α k f

def d_o.to_fun (f : C_o.pre 𝓕 U n) (α : vec_o U (n + 1)) : 𝓕.1.obj (op (face α)) :=
∑ (k : fin (n + 1)), d_o.to_fun.component k f α

variables (n 𝓕 U)
def d_o : C_o 𝓕 U n ⟶ C_o 𝓕 U (n + 1) :=
{ to_fun := d_o.to_fun,
  map_zero' := funext $ λ α, begin
    simp only [pi.zero_apply],
    change ∑ _, _ = _,
    rw finset.sum_eq_zero,
    intros i hi,
    change (ite _ id has_neg.neg) _ = _,
    split_ifs with e,
    { rw [id, pi.zero_apply, map_zero], },
    { rw [pi.zero_apply, map_zero, neg_zero], },
  end,
  map_add' := λ f g, funext $ λ α, begin
    rw pi.add_apply,
    change ∑ _, _ = ∑ _, _ + ∑ _, _,
    rw ← finset.sum_add_distrib,
    rw finset.sum_congr rfl,
    intros i _,
    change (ite _ id _) _ = (ite _ id _) _ + (ite _ id _) _,
    split_ifs with e,
    { rw [id, id, id, pi.add_apply, map_add], },
    { rw [pi.add_apply, map_add, neg_add], },
  end }

abbreviation dd_o : C_o 𝓕 U n ⟶ C_o 𝓕 U (n + 2) :=
d_o _ _ _ ≫ d_o _ _ _

namespace dd_o_aux

lemma d_o_def (f : C_o 𝓕 U n) (α : vec_o U (n + 1)) :
  d_o 𝓕 U n f α =
  ∑ (i : fin (n+1)),
    (ite (even i.1) id has_neg.neg)
      𝓕.1.map (hom_of_le $ face.le_ignore_o α i).op (f (ignore_o α i)) :=
begin
  rw [d_o],
  simp only [add_monoid_hom.coe_mk, fin.val_eq_coe],
  change ∑ _, _ = _,
  rw finset.sum_congr rfl,
  intros i _,
  change (ite _ id _) _ = _,
  split_ifs,
  { rw [id, id],
    refl, },
  { simpa, },
end

lemma eq1 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  d_o 𝓕 U (n + 1) (d_o 𝓕 U n f) α := rfl

lemma eq2 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (𝓕.1.map (hom_of_le (face.le_ignore_o α i)).op (d_o 𝓕 U n f (ignore_o α i))) :=
begin
  rw [eq1, d_o_def, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { simp },
  { simp },
end

lemma eq3 (f : C_o 𝓕 U n) (α : vec_o U (n+2))  :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (𝓕.1.map (hom_of_le (face.le_ignore α i)).op
        (∑ (j : fin (n + 1)),
          (ite (even j.1) id has_neg.neg)
            (𝓕.1.map (hom_of_le (face.le_ignore (ignore_o α i) j)).op (f (ignore_o (ignore_o α i) j))))) :=
begin
  rw [eq2, finset.sum_congr rfl],
  intros i _,
  rw [d_o_def],
  split_ifs,
  { simp only [id.def],
    rw [add_monoid_hom.map_sum, add_monoid_hom.map_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id],
      refl, },
    { simp only [pi.neg_apply, add_monoid_hom.neg_apply],
      refl, }, },
  { congr' 2,
    rw [finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id],
      refl, },
    { simp only [pi.neg_apply, add_monoid_hom.neg_apply, neg_inj],
      refl, } },
end

lemma eq4 (f : C_o 𝓕 U n) (α : vec_o U (n+2))  :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (∑ (j : fin (n + 1)),
        𝓕.1.map (hom_of_le (face.le_ignore_o α i)).op
          ((ite (even j.1) id has_neg.neg)
            𝓕.1.map (hom_of_le (face.le_ignore_o (ignore_o α i) j)).op
              (f (ignore_o (ignore_o α i) j)))) :=
begin
  rw [eq3, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [add_monoid_hom.map_sum, id, id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id],
      refl, },
    { simpa }, },
  { rw [add_monoid_hom.map_sum, finset.neg_sum, finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id],
      refl, },
    { simpa }, },
end

lemma eq5 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (∑ (j : fin (n + 1)),
        (ite (even j.1) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore_o α i)).op
          (𝓕.1.map (hom_of_le (face.le_ignore_o (ignore_o α i) j)).op
            (f (ignore_o (ignore_o α i) j))))) :=
begin
  rw [eq4, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [id, id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id], },
    { simp }, },
  { rw [finset.neg_sum, finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id], },
    { simp, }, },
end

lemma eq6₀ (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (∑ (j : fin (n + 1)),
        (ite (even j.1) id has_neg.neg)
        (𝓕.1.map ((hom_of_le (face.le_ignore (ignore α i) j)).op ≫ (hom_of_le (face.le_ignore α i)).op)
            (f (ignore_o (ignore_o α i) j)))) :=
begin
  rw [eq5, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [id, id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id, 𝓕.1.map_comp, comp_apply],
      refl, },
    { rw [𝓕.1.map_comp, comp_apply],
      refl, }, },
  { rw [finset.neg_sum, finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id, 𝓕.1.map_comp, comp_apply],
      refl, },
    { rw [neg_neg, neg_neg, 𝓕.1.map_comp, comp_apply],
      refl, }, }
end

lemma eq6₁ (f : C_o 𝓕 U n) (α : vec_o U (n+2))  :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (∑ (j : fin (n + 1)),
        (ite (even j.1) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore α i) ≫ hom_of_le (face.le_ignore (ignore α i) j)).op)
            (f (ignore_o (ignore_o α i) j))) :=
begin
  rw [eq6₀, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [id, id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id, op_comp], },
    { rw [op_comp],
      simp }, },
  { rw [finset.neg_sum, finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id, op_comp] },
    { rw [op_comp],
      simp }, }
end

lemma eq6₂ (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    (ite (even i.1) id has_neg.neg)
      (∑ (j : fin (n + 1)),
        (ite (even j.1) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore_o₂ α i j)).op)
            (f (ignore_o₂ α i j))) :=
begin
  rw [eq6₁, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [id, id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id], congr, },
    { congr, }, },
  { rw [finset.neg_sum, finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id], congr, },
    { congr }, },
end

lemma eq7 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)), ∑ (j : fin (n + 1)),
    (ite (even i.1) id has_neg.neg)
      (ite (even j.1) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore_o₂ α i j)).op)
            (f (ignore_o₂ α i j)) :=
begin
  rw [eq6₂, finset.sum_congr rfl],
  intros i _,
  split_ifs,
  { rw [id, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, id, id], },
    { rw [id], }, },
  { rw [finset.neg_sum, finset.sum_congr rfl],
    intros j _,
    split_ifs,
    { rw [id, pi.neg_apply, id], congr, },
    { rw [pi.neg_apply, neg_neg, add_monoid_hom.neg_apply, neg_neg], }, },
end

lemma eq8 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)), ∑ (j : fin (n + 1)),
    (ite (even (i.1 + j.1)) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j)) :=
begin
  rw [eq7, finset.sum_congr rfl],
  intros i _,
  rw [finset.sum_congr rfl],
  intros j _,
  split_ifs with h1 h2 h12,
  { refl, },
  { exfalso,
    apply h12,
    exact even.add_even h1 h2 },
  { exfalso,
    rw ← nat.odd_iff_not_even at h2,
    have := even.add_odd h1 h2,
    rw nat.odd_iff_not_even at this,
    apply this,
    exact h, },
  { rw [id],
    refl, },
  { rw ← nat.odd_iff_not_even at h1,
    have := odd.add_even h1 h,
    rw nat.odd_iff_not_even at this,
    exfalso,
    apply this,
    assumption, },
  { rw [pi.neg_apply, id],
    refl, },
  { rw [pi.neg_apply, neg_neg, id],
    refl, },
  { rw ← nat.odd_iff_not_even at *,
    have := odd.add_odd h1 h,
    rw nat.even_iff_not_odd at this,
    exfalso,
    apply this,
    assumption },
end

lemma eq9 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  ∑ (i : fin (n + 2)),
    ((∑ (j : fin (n + 1)) in finset.univ.filter (λ (j : fin (n + 1)), i.1 ≤ j.1),
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j))) +
    (∑ (j : fin (n + 1)) in finset.univ.filter (λ (j : fin (n + 1)), j.1 < i.1),
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j)))) :=
begin
  rw [eq8, finset.sum_congr rfl],
  intros i _,
  have :
    (finset.univ.filter (λ (j : fin (n + 1)), j.1 < i.val)) =
    (finset.univ.filter (λ (j : fin (n + 1)), i.val ≤ j.val))ᶜ,
  { ext1 k,
    split;
    intros hk;
    simp only [finset.compl_filter, not_le, finset.mem_filter, finset.mem_univ, true_and] at hk ⊢;
    assumption, },
  rw [this, finset.sum_add_sum_compl],
end

lemma eq11 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ (j : fin (n + 1)) in finset.univ.filter (λ (j : fin (n + 1)), i.1 ≤ j.1),
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j))) +
  (∑ (i : fin (n + 2)), ∑ (j : fin (n + 1)) in finset.univ.filter (λ (j : fin (n + 1)), j.1 < i.1),
    (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j))) :=
begin
  rw [eq9, finset.sum_add_distrib],
end

lemma eq13 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ (i : fin (n + 2)), ∑ (j : fin (n + 1)) in finset.univ.filter (λ (j : fin (n + 1)), j.1 < i.1),
    (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i j)).op)
            (f (ignore_o₂ α i j))) :=
begin
  rw [eq11],
  congr' 1,
  rw [finset.sum_congr rfl],
  intros i _,
  apply finset.sum_bij,

  work_on_goal 5
  { intros j hj,
    refine ⟨j.1, _⟩,
    rw finset.mem_Ico,
    rw finset.mem_filter at hj,
    refine ⟨hj.2, _⟩,
    exact j.2 },
  { intros j hj,
    dsimp only,
    rw finset.mem_filter at hj,
    apply finset.mem_attach, },
  { intros j hj,
    dsimp only,
    split_ifs,
    { rw [id, id],
      rw map_congr.vec_o_eq f (_ : ignore_o₂ α i j = ignore_o₂ α i ⟨j.1, _⟩),
      rw [← comp_apply, ← 𝓕.1.map_comp, ← op_comp],
      congr,
      congr' 1,
      rw subtype.ext_iff_val, },
    { rw [add_monoid_hom.neg_apply, add_monoid_hom.neg_apply],
      rw map_congr.vec_o_eq f (_ : ignore_o₂ α i j = ignore_o₂ α i ⟨j.1, _⟩),
      rw [← comp_apply, ← 𝓕.1.map_comp, ← op_comp],
      congr,
      congr' 1,
      rw subtype.ext_iff_val, }, },
  { intros j1 j2 h1 h2 H,
    dsimp only at H,
    rw subtype.ext_iff_val at *,
    assumption },
  { intros j _,
    have hj := j.2,
    rw finset.mem_Ico at hj,
    refine ⟨⟨j.1, hj.2⟩, _, _⟩,
    rw finset.mem_filter,
    refine ⟨finset.mem_univ ⟨j.val, _⟩, hj.1⟩,
    dsimp only,
    rw subtype.ext_iff_val, },
end

lemma eq14 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ (i : fin (n + 2)), ∑ j in (finset.range i.1).attach,
    (ite (even (i.1 + j)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_range at hj,
            have hi : i.1 ≤ n+1,
            { linarith [i.2], },
            linarith,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) :=
begin
  rw [eq13],
  congr' 1,
  rw [finset.sum_congr rfl],
  intros i hi,
  apply finset.sum_bij',

  work_on_goal 4
  { intros j hj,
    rw finset.mem_filter at hj,
    refine ⟨j.1, _⟩,
    rw finset.mem_range,
    exact hj.2 },
  work_on_goal 5
  { intros j _,
    have hj := j.2,
    rw finset.mem_range at hj,
    refine ⟨j.1, _⟩,
    linarith [i.2], },
  { intros j hj,
    dsimp only,
    split_ifs,
    { rw [id, id],
      rw map_congr.vec_o_eq f (_ : ignore_o₂ α i j = ignore_o₂ α i ⟨j.1, _⟩),
      rw [← comp_apply, ← 𝓕.1.map_comp, ← op_comp],
      congr,
      congr' 1,
      rw subtype.ext_iff_val, },
    { rw [add_monoid_hom.neg_apply, add_monoid_hom.neg_apply],
      rw map_congr.vec_o_eq f (_ : ignore_o₂ α i j = ignore_o₂ α i ⟨j.1, _⟩),
      rw [← comp_apply, ← 𝓕.1.map_comp, ← op_comp],
      congr,
      congr' 1,
      rw subtype.ext_iff_val, }, },
  { intros j hj,
    dsimp only,
    rw subtype.ext_iff_val, },
  { intros j hj,
    rw subtype.ext_iff_val, },
  { intros j hj,
    apply finset.mem_attach, },
  { intros j _,
    have hj := j.2,
    rw finset.mem_range at hj,
    rw finset.mem_filter,
    dsimp only,
    refine ⟨_, hj⟩,
    apply finset.mem_univ, },
end

lemma eq15 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ j in (finset.range n.succ).attach, ∑ i in (finset.Ico j.1.succ n.succ.succ).attach,
    (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rwa finset.mem_Ico at hi,
            exact hi.2,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rwa finset.mem_range at hj,
          end⟩)).op)
            (f (ignore_o₂ α _ _))) :=
begin
  rw [eq14],
  congr' 1,
  rw [finset.sum_sigma', finset.sum_sigma'],
  apply finset.sum_bij',
  work_on_goal 4
  { refine λ x h, ⟨⟨x.2.1, begin
    have hx2 := x.2.2,
    have hx1 := x.1.2,
    rw finset.mem_range at hx2 ⊢,
    have : x.1.1 ≤ n + 1,
    { linarith },
    refine lt_of_lt_of_le hx2 this,
  end⟩, ⟨x.1.1, _⟩⟩, },
  work_on_goal 6
  { refine λ x h, ⟨⟨x.2.1, begin
    have hx1 := x.1.2,
    have hx2 := x.2.2,
    rw finset.mem_range at hx1,
    rw finset.mem_Ico at hx2,
    exact hx2.2,
  end⟩, ⟨x.1.1, begin
    have hx1 := x.1.2,
    have hx2 := x.2.2,
    rw finset.mem_range at hx1 ⊢,
    rw finset.mem_Ico at hx2,
    refine lt_of_le_of_lt _ hx2.1,
    refl,
  end⟩⟩, },
  { rintros ⟨⟨i, hi⟩, j⟩ h,
    dsimp only,
    congr, },
  { rintros ⟨⟨i, hi⟩, j⟩ h,
    simp only,
    split,
    refl,
    rw heq_iff_eq,
    rw subtype.ext_iff_val, },
  { rintros ⟨i, j⟩ h,
    simp only,
    split,
    rw subtype.ext_iff_val,
    rw heq_iff_eq,
    rw subtype.ext_iff_val, },
  { have hx1 := x.1.2,
    have hx2 := x.2.2,
    rw finset.mem_range at hx2,
    rw finset.mem_Ico,
    refine ⟨_, hx1⟩,
    exact hx2, },
  { rintros ⟨i, j⟩ h,
    rw finset.mem_sigma,
    split,
    apply finset.mem_attach,
    apply finset.mem_attach },
  { intros x h,
    rw finset.mem_sigma,
    split,
    apply finset.mem_univ,
    apply finset.mem_attach, },
end

lemma eq16 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, ∑ j in (finset.Ico i.1.succ n.succ.succ).attach,
    (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨j.1, begin
            have hi := j.2,
            rwa finset.mem_Ico at hi,
            exact hi.2,
          end⟩ ⟨i.1, begin
            have hj := i.2,
            rwa finset.mem_range at hj,
          end⟩)).op)
            (f (ignore_o₂ α _ _))) :=
begin
  rw [eq15],
end

lemma eq17 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even ((j.1 + 1) + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨j.1 + 1, begin
            have hi := j.2,
            rw finset.mem_Ico at hi,
            rw succ_lt_succ_iff,
            exact hi.2,
          end⟩ ⟨i.1, begin
            have hj := i.2,
            rwa finset.mem_range at hj,
          end⟩)).op)
            (f (ignore_o₂ α ⟨j.1 + 1, _⟩ ⟨i.1, _⟩))) :=
begin
  rw [eq16],
  congr' 1,
  rw finset.sum_congr rfl,
  intros i hi,
  apply finset.sum_bij',
  work_on_goal 4
  { intros j _, refine ⟨j.1.pred, _⟩,
    have hj := j.2,
    rw finset.mem_Ico at hj ⊢,
    rcases hj with ⟨hj1, hj2⟩,
    have ineq0 : 0 < j.1,
    { refine lt_of_lt_of_le _ hj1,
      exact nat.zero_lt_succ _, },
    have eq1 : j.1 = j.1.pred.succ,
    { rwa nat.succ_pred_eq_of_pos, },
    split,
    rw eq1 at hj1,
    rwa succ_le_succ_iff at hj1,

    rw eq1 at hj2,
    rwa succ_lt_succ_iff at hj2 },
  work_on_goal 5
  { intros j _, refine ⟨j.1 + 1, _⟩,
    have hj := j.2,
    rw finset.mem_Ico at hj ⊢,
    rcases hj with ⟨hj1, hj2⟩,
    split,

    rwa succ_le_succ_iff,
    rwa succ_lt_succ_iff,
    },
  { intros j hj,
    dsimp only,
    rw map_congr.vec_o_eq f (_ : ignore_o₂ α ⟨j.1, _⟩ ⟨i.1, _⟩ = ignore_o₂ α ⟨j.1.pred + 1, _⟩ ⟨i.1, _⟩),
    by_cases e1 : even (j.1 + i.1),
    { rw [if_pos e1, if_pos, id, id, ← comp_apply, ← 𝓕.1.map_comp], congr,
      rwa [← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
      have hj := j.2,
      rw finset.mem_Ico at hj,
      refine lt_of_lt_of_le _ hj.1,
      exact nat.zero_lt_succ _, },
    { rw [if_neg e1, if_neg, add_monoid_hom.neg_apply, add_monoid_hom.neg_apply, ← comp_apply, ← 𝓕.1.map_comp],
      congr,
      rwa [← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
      have hj := j.2,
      rw finset.mem_Ico at hj,
      refine lt_of_lt_of_le _ hj.1,
      exact nat.zero_lt_succ _, },
    congr,
    rwa [← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
    have hj := j.2,
    rw finset.mem_Ico at hj,
    refine lt_of_lt_of_le _ hj.1,
    exact nat.zero_lt_succ _, },
  { intros j hj,
    simp only,
    rw subtype.ext_iff_val,
    dsimp only,
    rw [← nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
    have hj := j.2,
    rw finset.mem_Ico at hj,
    refine lt_of_lt_of_le _ hj.1,
    exact nat.zero_lt_succ _, },
  { intros j hj,
    simp only,
    rw subtype.ext_iff_val,
    dsimp only,
    rw nat.pred_succ, },
  { intros j hj,
    apply finset.mem_attach, },
  { intros j hj,
    apply finset.mem_attach, },
end

lemma eq18 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even ((j.1 + 1) + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
begin
  rw eq17 𝓕 U n f α,
  apply congr_arg2 (+) rfl _,
  rw [finset.sum_congr rfl],
  intros i hi,
  rw [finset.sum_congr rfl],
  intros j hj,
  generalize_proofs _ h1 h2 h3 h4 h5,
  rw map_congr.vec_o_eq f (_ : ignore_o₂ α ⟨j.1 + 1, h1⟩ ⟨i.1, h2⟩ = ignore_o₂ α ⟨i.1, h4⟩ ⟨j.1, _⟩),
  split_ifs,
  { rw [id, id, ← comp_apply, ← 𝓕.1.map_comp],
    congr },
  { rw [add_monoid_hom.neg_apply, add_monoid_hom.neg_apply, ← comp_apply, ← 𝓕.1.map_comp],
    congr },
  have := ignore_o₂_symm' α i.2 j.2,
  convert ← this,
end

lemma eq19 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ (i : fin (n + 2)), ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α i ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α i ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, - ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq18],
  congr' 1,
  rw [finset.sum_congr rfl],
  intros i _,
  rw [finset.neg_sum, finset.sum_congr rfl],
  intros j _,
  split_ifs with h1 h2,
  { exfalso,
    have o1 : odd (1 : ℕ) := odd_one,
    have := even.add_odd h2 o1,
    rw nat.odd_iff_not_even at this,
    apply this,
    convert h1 using 1,
    abel, },
  { rw [id, add_monoid_hom.neg_apply, neg_neg], },
  { rw [id, add_monoid_hom.neg_apply], },
  { rw ← nat.odd_iff_not_even at h h1,
    have o1 : odd (1 : ℕ) := odd_one,
    have := odd.add_odd h o1,
    rw nat.even_iff_not_odd at this,
    exfalso,
    apply this,
    convert h1 using 1,
    abel, },
end

lemma eq20₀ (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ i in (finset.range (n+2)).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            exact finset.mem_range.mp hi,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, - ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq19],
  congr' 1,
  rw finset.sum_fin_eq_sum_range,
  rw ← finset.sum_attach,
  rw finset.sum_congr rfl,
  intros i hi,
  rw dif_pos,
  refl,
end

lemma eq20₁ (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ i in (finset.range (n+1)).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            refine lt_trans (finset.mem_range.mp hi) _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) +
  (∑ j in (finset.Ico n.succ n.succ).attach,
    (ite (even (n.succ + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨n.succ, begin
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨n.succ, _⟩ ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, - ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) :=
have eq0 :
  ∑ i in (finset.range (n+2)).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (i.1 + j.1)) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
          have hi := i.2,
          exact finset.mem_range.mp hi,
        end⟩ ⟨j.1, begin
          have hj := j.2,
          rw finset.mem_Ico at hj,
          exact hj.2,
        end⟩)).op)
          (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩)) =
  ∑ i in (insert n.succ (finset.range (n+1))).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (i.1 + j.1)) id has_neg.neg)
        (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
          have hi := i.2,
          rw finset.mem_insert at hi,
          cases hi,
          rw hi, exact lt_add_one _,

          rw finset.mem_range at hi,
          refine lt_trans hi _,
          exact lt_add_one _,
        end⟩ ⟨j.1, begin
          have hj := j.2,
          rw finset.mem_Ico at hj,
          exact hj.2,
        end⟩)).op)
          (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩)),
begin
  rw finset.sum_bij',
  work_on_goal 4
  { intros a _,
    refine ⟨a.1, _⟩,
    rw finset.mem_insert,
    have ha := a.2,
    by_cases a.1 = n.succ,
    left, assumption,
    right,
    rw finset.mem_range at ha ⊢,
    contrapose! h,
    have ha' : a.1 ≤ n+1,
    linarith,
    refine le_antisymm ha' h, },
  work_on_goal 5
  { intros a _,
    refine ⟨a.1, _⟩,
    have ha := a.2,
    rw finset.mem_insert at ha,
    rw finset.mem_range at ha ⊢,
    cases ha,
    rw ha, exact lt_add_one _,
    linarith, },
  { intros, simp only, },
  { intros, simp only, rw subtype.ext_iff_val, },
  { intros, simp only, rw subtype.ext_iff_val, },
  { intros, simp only,
    apply finset.mem_attach },
  { intros, apply finset.mem_attach },
end,
begin
  rw [eq20₀],
  apply congr_arg2 (+) _ rfl,
  rw eq0,
  rw finset.attach_insert,
  rw finset.sum_insert,
  conv_lhs { simp only [add_comm] },
  congr' 1,
  { simp only [finset.sum_image, subtype.forall, subtype.coe_mk, imp_self, implies_true_iff], },
  { rw finset.mem_image,
    push_neg,
    intros a _,
    have ha := a.2,
    rw finset.mem_range at ha,
    intro r,
    rw r at ha,
    apply lt_irrefl _ ha, },
end

lemma eq21 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ i in (finset.range (n+1)).attach, ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            refine lt_trans (finset.mem_range.mp hi) _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) +
  (∑ i in (finset.range n.succ).attach, - ∑ j in (finset.Ico i.1 n.succ).attach,
    (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) +
  (∑ j in (finset.Ico n.succ n.succ).attach,
    (ite (even (n.succ + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨n.succ, begin
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨n.succ, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq20₁],
  abel,
end

lemma eq22 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ i in (finset.range (n+1)).attach,
    ((∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (i.1 + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            refine lt_trans (finset.mem_range.mp hi) _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))) +
    (- ∑ j in (finset.Ico i.1 n.succ).attach,
      (ite (even (j.1 + i.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨i.1, begin
            have hi := i.2,
            rw finset.mem_range at hi,
            refine lt_trans hi _,
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨i.1, _⟩ ⟨j.1, _⟩))))) +
  (∑ j in (finset.Ico n.succ n.succ).attach,
    (ite (even (n.succ + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨n.succ, begin
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨n.succ, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq21, finset.sum_add_distrib],
end

lemma eq23 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α =
  (∑ i in (finset.range (n+1)).attach, 0) +
  (∑ j in (finset.Ico n.succ n.succ).attach,
    (ite (even (n.succ + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨n.succ, begin
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨n.succ, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq22],
  congr' 1,
  rw finset.sum_congr rfl,
  intros i _,
  simp_rw [add_comm],
  rw add_neg_eq_zero,
end

lemma eq24 (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α = 0 +
  (∑ j in (finset.Ico n.succ n.succ).attach,
    (ite (even (n.succ + j.1)) id has_neg.neg)
          (𝓕.1.map (hom_of_le (face.le_ignore₂ α ⟨n.succ, begin
            exact lt_add_one _,
          end⟩ ⟨j.1, begin
            have hj := j.2,
            rw finset.mem_Ico at hj,
            exact hj.2,
          end⟩)).op)
            (f (ignore_o₂ α ⟨n.succ, _⟩ ⟨j.1, _⟩))) :=
begin
  rw [eq23],
  congr',
  rw finset.sum_eq_zero,
  intros, refl,
end

lemma eq_zero (f : C_o 𝓕 U n) (α : vec_o U (n+2)) :
  dd_o 𝓕 U n f α = 0 :=
begin
  rw [eq24, zero_add],
  convert finset.sum_empty,
  rw finset.Ico_self,
  rw finset.attach_empty
end

end dd_o_aux

lemma dd_o_eq_zero' (n : ℕ) : dd_o 𝓕 U n = 0 :=
begin
  ext f α,
  convert dd_o_aux.eq_zero 𝓕 U n f α,
end

lemma dd_o_eq_zero (n : ℕ) (f α) :
  d_o 𝓕 U (n+1) (d_o 𝓕 U n f) α = 0 :=
begin
  have : dd_o 𝓕 U n f α = 0,
  { rw dd_o_eq_zero',
    simp },
  exact this,
end

end d_o

namespace d_o_small

open_locale big_operators

lemma vec_one_ignore_eq (α : vec_o U 1) :
  ignore_o α 0 =
  vec_o.zero U :=
begin
  ext j,
  rcases j with ⟨j, hj⟩,
  linarith,
end

lemma d_o.zeroth_apply (f : C_o 𝓕 U 0) (α : vec_o U 1) :
  d_o 𝓕 U _ f α =
  𝓕.1.map (hom_of_le $ begin
    rw face.vec_o_zero,
    exact le_top,
  end).op (f (vec_o.zero U)) :=
begin
  rw dd_o_aux.d_o_def,
  rw finset.sum_fin_eq_sum_range,
  rw finset.sum_range_one,
  rw dif_pos,
  swap, exact nat.zero_lt_succ _,
  rw if_pos,
  swap, exact even_zero,
  rw [id],
  erw map_congr.vec_o_eq f (vec_one_ignore_eq U α),
  rw [← comp_apply, ← 𝓕.1.map_comp],
  congr' 1,
end

lemma d_o.one_apply (f : C_o 𝓕 U 1) (α : vec_o U 2) :
  d_o 𝓕 U 1 f α =
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op (f (ignore_o α 0)) -
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op (f (ignore_o α 1)) :=
begin
  rw dd_o_aux.d_o_def,
  rw finset.sum_fin_eq_sum_range,
  have seteq : finset.range (1 + 1) = {0, 1},
  { norm_num,
    ext,
    split,
    { intros h,
      rw finset.mem_range at h,
      rw [finset.mem_insert, finset.mem_singleton],
      interval_cases a;
      cc, },
    { intros h,
      rw [finset.mem_insert, finset.mem_singleton] at h,
      rw finset.mem_range,
      rcases h with rfl|rfl;
      linarith, }, },
  rw [seteq, finset.sum_pair],
  swap, linarith,
  rw [dif_pos (nat.zero_lt_succ _), if_pos (even_zero), id, dif_pos (lt_add_one 1), if_neg],
  swap,
    rw ← nat.odd_iff_not_even,
    exact odd_one,
  change _ + (- 𝓕.1.map _ _) = _,
  rw ← sub_eq_add_neg,
  refl,
end

end d_o_small

end


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
prelude
import init.data.nat init.data.bool init.ite_simp
universes u v w

/-- In the VM, d_array is implemented as a persistent array. -/
structure d_array (n : nat) (α : fin n → Type u) :=
(data : Π i : fin n, α i)

namespace d_array
variables {n : nat} {α : fin n → Type u} {α' : fin n → Type v} {β : Type w}

/-- The empty array. -/
def nil {α} : d_array 0 α :=
{data := λ ⟨x, h⟩, absurd h (nat.not_lt_zero x)}

/-- `read a i` reads the `i`th member of `a`. Has builtin VM implementation. -/
def read (a : d_array n α) (i : fin n) : α i :=
a.data i

/-- `write a i v` sets the `i`th member of `a` to be `v`. Has builtin VM implementation. -/
def write (a : d_array n α) (i : fin n) (v : α i) : d_array n α :=
{data := λ j, if h : i = j then eq.rec_on h v else a.read j}

def iterate_aux (a : d_array n α) (f : Π i : fin n, α i → β → β) : Π (i : nat), i ≤ n → β → β
| 0     h b := b
| (j+1) h b :=
  let i : fin n := ⟨j, h⟩ in
  f i (a.read i) (iterate_aux j (le_of_lt h) b)

/-- Fold over the elements of the given array in ascending order. Has builtin VM implementation. -/
def iterate (a : d_array n α) (b : β) (f : Π i : fin n, α i → β → β) : β :=
iterate_aux a f n (le_refl _) b

/-- Map the array. Has builtin VM implementation. -/
def foreach (a : d_array n α) (f : Π i : fin n, α i → α' i) : d_array n α' :=
⟨λ i, f _ (a.read i)⟩

def map (f : Π i : fin n, α i → α' i) (a : d_array n α) : d_array n α' :=
foreach a f

def map₂ {α'' : fin n → Type w} (f : Π i : fin n, α i → α' i → α'' i) (a : d_array n α) (b : d_array n α') :
  d_array n α'' :=
foreach b (λ i, f i (a.read i))

def foldl (a : d_array n α) (b : β) (f : Π i : fin n, α i → β → β) : β :=
iterate a b f

def rev_iterate_aux (a : d_array n α) (f : Π i : fin n, α i → β → β) : Π (i : nat), i ≤ n → β → β
| 0     h b := b
| (j+1) h b :=
  let i : fin n := ⟨j, h⟩ in
  rev_iterate_aux j (le_of_lt h) (f i (a.read i) b)

def rev_iterate (a : d_array n α) (b : β) (f : Π i : fin n, α i → β → β) : β :=
rev_iterate_aux a f n (le_refl _) b

@[simp]

@[simp] lemma read_write_of_ne (a : d_array n α) {i j : fin n} (v : α i) : i ≠ j → read (write a i v) j = read a j :=
by intro h; simp [read, write, h]

protected lemma ext {a b : d_array n α} (h : ∀ i, read a i = read b i) : a = b :=
by cases a; cases b; congr; exact funext h

protected lemma ext' {a b : d_array n α} (h : ∀ (i : nat) (h : i < n), read a ⟨i, h⟩ = read b ⟨i, h⟩) : a = b :=
begin cases a, cases b, congr, funext i, cases i, apply h end

protected def beq_aux [∀ i, decidable_eq (α i)] (a b : d_array n α) : Π (i : nat), i ≤ n → bool
| 0     h := tt
| (i+1) h := if a.read ⟨i, h⟩ = b.read ⟨i, h⟩ then beq_aux i (le_of_lt h) else ff

/-- Boolean element-wise equality check. -/
protected def beq [∀ i, decidable_eq (α i)] (a b : d_array n α) : bool :=
d_array.beq_aux a b n (le_refl _)

lemma of_beq_aux_eq_tt [∀ i, decidable_eq (α i)] {a b : d_array n α} : ∀ (i : nat) (h : i ≤ n), d_array.beq_aux a b i h = tt →
                       ∀ (j : nat) (h' : j < i), a.read ⟨j, lt_of_lt_of_le h' h⟩ = b.read ⟨j, lt_of_lt_of_le h' h⟩
| 0     h₁ h₂ j h₃ := absurd h₃ (nat.not_lt_zero _)
| (i+1) h₁ h₂ j h₃ :=
  begin
    have h₂' : read a ⟨i, h₁⟩ = read b ⟨i, h₁⟩ ∧ d_array.beq_aux a b i _ = tt, {simp [d_array.beq_aux] at h₂, assumption},
    have h₁' : i ≤ n, from le_of_lt h₁,
    have ih  : ∀ (j : nat) (h' : j < i), a.read ⟨j, lt_of_lt_of_le h' h₁'⟩ = b.read ⟨j, lt_of_lt_of_le h' h₁'⟩, from of_beq_aux_eq_tt i h₁' h₂'.2,
    by_cases hji : j = i,
    { subst hji, exact h₂'.1 },
    { have j_lt_i : j < i, from lt_of_le_of_ne (nat.le_of_lt_succ h₃) hji,
      exact ih j j_lt_i }
  end

lemma of_beq_eq_tt [∀ i, decidable_eq (α i)] {a b : d_array n α} : d_array.beq a b = tt → a = b :=
begin
  unfold d_array.beq,
  intro h,
  have : ∀ (j : nat) (h : j < n), a.read ⟨j, h⟩ = b.read ⟨j, h⟩, from
    of_beq_aux_eq_tt n (le_refl _) h,
  apply d_array.ext' this
end

lemma of_beq_aux_eq_ff [∀ i, decidable_eq (α i)] {a b : d_array n α} : ∀ (i : nat) (h : i ≤ n), d_array.beq_aux a b i h = ff →
                       ∃ (j : nat) (h' : j < i), a.read ⟨j, lt_of_lt_of_le h' h⟩ ≠ b.read ⟨j, lt_of_lt_of_le h' h⟩
| 0     h₁ h₂ := begin simp [d_array.beq_aux] at h₂, contradiction end
| (i+1) h₁ h₂ :=
  begin
    have h₂' : read a ⟨i, h₁⟩ ≠ read b ⟨i, h₁⟩ ∨ d_array.beq_aux a b i _ = ff, {simp [d_array.beq_aux] at h₂, assumption},
    cases h₂' with h h,
    { existsi i, existsi (nat.lt_succ_self _), exact h },
    { have h₁' : i ≤ n, from le_of_lt h₁,
      have ih : ∃ (j : nat) (h' : j < i), a.read ⟨j, lt_of_lt_of_le h' h₁'⟩ ≠ b.read ⟨j, lt_of_lt_of_le h' h₁'⟩, from of_beq_aux_eq_ff i h₁' h,
      cases ih with j ih,
      cases ih with h' ih,
      existsi j, existsi (nat.lt_succ_of_lt h'),
      exact ih }
  end

lemma of_beq_eq_ff [∀ i, decidable_eq (α i)] {a b : d_array n α} : d_array.beq a b = ff → a ≠ b :=
begin
  unfold d_array.beq,
  intros h hne,
  have : ∃ (j : nat) (h' : j < n), a.read ⟨j, h'⟩ ≠ b.read ⟨j, h'⟩, from of_beq_aux_eq_ff n (le_refl _) h,
  cases this with j this,
  cases this with h' this,
  subst hne,
  contradiction
end

instance [∀ i, decidable_eq (α i)] : decidable_eq (d_array n α) :=
λ a b, if h : d_array.beq a b = tt then is_true (of_beq_eq_tt h) else is_false (of_beq_eq_ff (eq_ff_of_not_eq_tt h))

end d_array

/-- A non-dependent array (see `d_array`). Implemented in the VM as a persistent array.  -/
def array (n : nat) (α : Type u) : Type u :=
d_array n (λ _, α)

/-- `mk_array n v` creates a new array of length `n` where each element is `v`. Has builtin VM implementation. -/
def mk_array {α} (n) (v : α) : array n α :=
{data := λ _, v}

namespace array
variables {n : nat} {α : Type u} {β : Type v}

def nil {α} : array 0 α :=
d_array.nil

@[inline]
def read (a : array n α) (i : fin n) : α :=
d_array.read a i

@[inline]
def write (a : array n α) (i : fin n) (v : α) : array n α :=
d_array.write a i v

/-- Fold array starting from 0, folder function includes an index argument. -/
@[inline]
def iterate (a : array n α) (b : β) (f : fin n → α → β → β) : β :=
d_array.iterate a b f

/-- Map each element of the given array with an index argument. -/
@[inline]
def foreach (a : array n α) (f : fin n → α → β) : array n β :=
d_array.foreach a f

@[inline]
def map₂ (f : α → α → α) (a b : array n α) : array n α :=
foreach b (λ i, f (a.read i))

@[inline]
def foldl (a : array n α) (b : β) (f : α → β → β) : β :=
iterate a b (λ _, f)

def rev_list (a : array n α) : list α :=
a.foldl [] (::)

def rev_iterate (a : array n α) (b : β) (f : fin n → α → β → β) : β :=
d_array.rev_iterate a b f

def rev_foldl (a : array n α) (b : β) (f : α → β → β) : β :=
rev_iterate a b (λ _, f)

def to_list (a : array n α) : list α :=
a.rev_foldl [] (::)

lemma push_back_idx {j n} (h₁ : j < n + 1) (h₂ : j ≠ n) : j < n :=
nat.lt_of_le_and_ne (nat.le_of_lt_succ h₁) h₂

/-- `push_back a v` pushes value `v` to the end of the array. Has builtin VM implementation. -/
def push_back (a : array n α) (v : α) : array (n+1) α :=
{data := λ ⟨j, h₁⟩, if h₂ : j = n then v else a.read ⟨j, push_back_idx h₁ h₂⟩}

lemma pop_back_idx {j n} (h : j < n) : j < n + 1 :=
nat.lt.step h

/-- Discard _last_ element in the array. Has builtin VM implementation. -/
def pop_back (a : array (n+1) α) : array n α :=
{data := λ ⟨j, h⟩, a.read ⟨j, pop_back_idx h⟩}

/-- Auxilliary function for monadically mapping a function over an array. -/
@[inline]
def mmap_core {β : Type v} {m : Type v → Type w} [monad m] (a : array n α) (f : α → m β) :
  ∀ i ≤ n, m (array i β)
| 0 _ := pure d_array.nil
| (i+1) h := do
    bs ← mmap_core i (le_of_lt h),
    b ← f (a.read ⟨i, h⟩),
    pure $ bs.push_back b

/-- Monadically map a function over the array. -/
@[inline]
def mmap {β : Type v} {m} [monad m] (a : array n α) (f : α → m β) : m (array n β) :=
a.mmap_core f _ (le_refl _)

/-- Map a function over the array. -/
@[inline]
def map {β : Type v} (a : array n α) (f : α → β) : array n β :=
a.map (λ _, f)

protected def mem (v : α) (a : array n α) : Prop :=
∃ i : fin n, read a i = v

instance : has_mem α (array n α) := ⟨array.mem⟩

theorem read_mem (a : array n α) (i) : read a i ∈ a :=
exists.intro i rfl

instance [has_repr α] : has_repr (array n α) :=
⟨repr ∘ to_list⟩

meta instance [has_to_format α] : has_to_format (array n α) :=
⟨to_fmt ∘ to_list⟩

meta instance [has_to_tactic_format α] : has_to_tactic_format (array n α) :=
⟨tactic.pp ∘ to_list⟩

@[simp] lemma read_write (a : array n α) (i : fin n) (v : α) : read (write a i v) i = v :=
d_array.read_write a i v

@[simp] lemma read_write_of_ne (a : array n α) {i j : fin n} (v : α) : i ≠ j → read (write a i v) j = read a j :=
d_array.read_write_of_ne a v

def read' [inhabited β] (a : array n β) (i : nat) : β :=
if h : i < n then a.read ⟨i,h⟩ else default

def write' (a : array n α) (i : nat) (v : α) : array n α :=
if h : i < n then a.write ⟨i, h⟩ v else a

lemma read_eq_read' [inhabited α] (a : array n α) {i : nat} (h : i < n) : read a ⟨i, h⟩ = read' a i :=
by simp [read', h]

lemma write_eq_write' (a : array n α) {i : nat} (h : i < n) (v : α) : write a ⟨i, h⟩ v = write' a i v :=
by simp [write', h]

protected lemma ext {a b : array n α} (h : ∀ i, read a i = read b i) : a = b :=
d_array.ext h

protected lemma ext' {a b : array n α} (h : ∀ (i : nat) (h : i < n), read a ⟨i, h⟩ = read b ⟨i, h⟩) : a = b :=
d_array.ext' h

instance [decidable_eq α] : decidable_eq (array n α) :=
begin unfold array, apply_instance end

end array


import SciLean.Core

namespace SciLean

class SetElem (Cont : Type u) (Idx : Type v) (Elem : outParam (Type w)) where
  setElem : (const : Cont) → (idx : Idx) → (elem : Elem) → Cont

export SetElem (setElem)

-- class ModifyElem (Cont : Type u) (Idx : Type v) (Elem : outParam (Type w)) where
--   modifyElem : (x : Cont) → (i : Idx) → (f : Elem → Elem) → Cont

-- export ModifyElem (modifyElem)

class IntroElem (Cont : Type u) (Idx : Type v) (Elem : outParam (Type w)) where
  introElem : (f : Idx → Elem) → Cont

export IntroElem (introElem)

class PushElem (Cont : Nat → Type u) (Elem : outParam (Type w)) where
  pushElem (k : Nat) (elem : Elem) : Cont n → Cont (n + k)

export PushElem (pushElem)

class DropElem (Cont : Nat → Type u) (Elem : outParam (Type w)) where
  dropElem (k : Nat) : Cont (n + k) → Cont n

export DropElem (dropElem)

class ReserveElem (Cont : Nat → Type u) (Elem : outParam (Type w)) where
  reserveElem (k : Nat) : Cont n → Cont n

export ReserveElem (reserveElem)

/-- This class says that `Cont` behaves like an array with `Elem` values indexed by `Idx`

Examples for `Idx = Fin n` and `Elem = ℝ` are: `ArrayN ℝ n` or `ℝ^{n}`

For `array : Cont` you can:
  1. get values: `getElem array x : Elem` for `x : Idx`
  2. set values: `setElem array x y : Cont` for `x : Idx` and `y : Elem`
  3. make new a array: `introElem f : Cont` for `f : Idx → Elem`

Alternative notation:
  1. `array[x]`
  2. in `do` block: `array[x] := y`, `array[x] += y`, ...
  3. `λ [x] => f x` this notation works only if the type `Cont` can be infered from the context
     Common use: `let array : Cont := λ [x] => f x` where the type asscription `: Cont` is important.
-/
class ArrayType (Cont : Type u) (Idx : Type v |> outParam) (Elem : Type w |> outParam)
  extends GetElem Cont Idx Elem (λ _ _ => True),
          SetElem Cont Idx Elem,
          IntroElem Cont Idx Elem
  where
  ext : ∀ f g : Cont, (∀ x : Idx, f[x] = g[x]) ↔ f = g
  getElem_setElem_eq  : ∀ (x : Idx) (y : Elem) (f : Cont), (setElem f x y)[x] = y
  getElem_setElem_neq : ∀ (i j : Idx) (val : Elem) (arr : Cont), i ≠ j → (setElem arr i val)[j] = arr[j]
  getElem_introElem : ∀ f i, (introElem f)[i] = f i

attribute [simp] ArrayType.getElem_setElem_eq ArrayType.getElem_introElem
attribute [default_instance] ArrayType.toGetElem ArrayType.toSetElem ArrayType.toIntroElem

class LinearArrayType (Cont : Nat → Type u) (Elem : Type w |> outParam)
  extends PushElem Cont Elem,
          DropElem Cont Elem,
          ReserveElem Cont Elem
  where
  toArrayType : ∀ n, ArrayType (Cont n) (Fin n) Elem

  pushElem_getElem : ∀ n k val (i : Fin (n+k)) (x : Cont n), n ≤ i.1 →
    have : ∀ n', GetElem (Cont n') (Fin n') Elem (λ _ _ => True) := λ n' => (toArrayType n').toGetElem
    (pushElem k val x)[i] = val

  dropElem_getElem : ∀ n k (i : Fin n) (x : Cont (n+k)),
    have : ∀ n', GetElem (Cont n') (Fin n') Elem (λ _ _ => True) := λ n' => (toArrayType n').toGetElem
    (dropElem k x)[i] = x[(⟨i.1, sorry_proof⟩ : Fin (n+k))]

  reserveElem_id : ∀ (x : Cont n) (k), reserveElem k x = x

instance {T} {Y : outParam Type} [inst : LinearArrayType T Y] (n) : ArrayType (T n) (Fin n) Y := inst.toArrayType n

namespace ArrayType

variable {Cont : Type} {Idx : Type |> outParam} {Elem : Type |> outParam}

-- TODO: Make an inplace modification
-- Maybe turn this into a class and this is a default implementation
@[inline]
def modifyElem [GetElem Cont Idx Elem λ _ _ => True] [SetElem Cont Idx Elem]
  (arr : Cont) (i : Idx) (f : Elem → Elem) : Cont :=
  setElem arr i (f (arr[i]))

@[simp]
theorem getElem_modifyElem_eq [ArrayType Cont Idx Elem] (cont : Cont) (idx : Idx) (f : Elem → Elem)
  : (modifyElem cont idx f)[idx] = f cont[idx] := by simp[modifyElem]; done

@[simp]
theorem getElem_modifyElem_neq [inst : ArrayType Cont Idx Elem] (arr : Cont) (i j : Idx) (f : Elem → Elem)
  : i ≠ j → (modifyElem arr i f)[j] = arr[j] := by simp[modifyElem]; apply ArrayType.getElem_setElem_neq; done

-- Maybe turn this into a class and this is a default implementation
-- For certain types there might be a faster implementation
def mapIdx [ArrayType Cont Idx Elem] [Enumtype Idx] (f : Idx → Elem → Elem) (arr : Cont) : Cont := Id.run do
  let mut arr := arr
  for (i,_) in Enumtype.fullRange Idx do
    -- This notation should correctly handle aliasing
    -- It should expand to `f := modifyElem f x (g x) True.intro`
    -- This prevent from making copy of `f[x]`
    arr := modifyElem arr i (f i)
  arr

@[simp]
theorem getElem_mapIdx [ArrayType Cont Idx Elem] [Enumtype Idx] (f : Idx → Elem → Elem) (arr : Cont) (i : Idx)
  : (mapIdx f arr)[i] = f i arr[i] := sorry_proof

def map [ArrayType Cont Idx Elem] [Enumtype Idx] (f : Elem → Elem) (arr : Cont) : Cont :=
  mapIdx (λ _ => f) arr

@[simp]
theorem getElem_map [ArrayType Cont Idx Elem] [Enumtype Idx] (f : Elem → Elem) (arr : Cont) (i : Idx)
  : (map f arr)[i] = f arr[i] := sorry_proof

instance [ArrayType Cont Idx Elem] [ToString Elem] [Enumtype Idx] : ToString (Cont) := ⟨λ a =>
  match Iterable.first (ι:=Idx) with
  | some fst => Id.run do
    let mut s : String := s!"'[{a[fst]}"
    for (i,li) in Enumtype.fullRange Idx do
      if li.1 = 0 then continue else
      s := s ++ s!", {a[i]}"
    s ++ "]"
  | none => "'[]"⟩

section Operations

  variable [ArrayType Cont Idx Elem] [Enumtype Idx]

  instance [Add Elem] : Add Cont := ⟨λ f g => mapIdx (λ x fx => fx + g[x]) f⟩
  instance [Sub Elem] : Sub Cont := ⟨λ f g => mapIdx (λ x fx => fx - g[x]) f⟩
  instance [Mul Elem] : Mul Cont := ⟨λ f g => mapIdx (λ x fx => fx * g[x]) f⟩
  instance [Div Elem] : Div Cont := ⟨λ f g => mapIdx (λ x fx => fx / g[x]) f⟩

  -- instance {R} [HMul R Elem Elem] : HMul R Cont Cont := ⟨λ r f => map (λ fx => r*(fx : Elem)) f⟩
  instance {R} [SMul R Elem] : SMul R Cont := ⟨λ r f => map (λ fx => r•(fx : Elem)) f⟩

  instance [Neg Elem] : Neg Cont := ⟨λ f => map (λ fx => -(fx : Elem)) f⟩
  instance [Inv Elem] : Inv Cont := ⟨λ f => map (λ fx => (fx : Elem)⁻¹) f⟩

  instance [One Elem]  : One Cont  := ⟨introElem λ _ : Idx => 1⟩
  instance [Zero Elem] : Zero Cont := ⟨introElem λ _ : Idx => 0⟩

  instance [LT Elem] : LT Cont := ⟨λ f g => ∀ x, f[x] < g[x]⟩
  instance [LE Elem] : LE Cont := ⟨λ f g => ∀ x, f[x] ≤ g[x]⟩

  instance [DecidableEq Elem] : DecidableEq Cont :=
    λ f g => Id.run do
      let mut eq : Bool := true
      for (x,_) in Enumtype.fullRange Idx do
        if f[x] ≠ g[x] then
          eq := false
          break
      if eq then isTrue sorry else isFalse sorry

  instance [LT Elem] [∀ x y : Elem, Decidable (x < y)] (f g : Cont) : Decidable (f < g) := Id.run do
    let mut lt : Bool := true
    for (x,_) in Enumtype.fullRange Idx do
      if ¬(f[x] < g[x]) then
        lt := false
        break
    if lt then isTrue sorry else isFalse sorry

  instance [LE Elem] [∀ x y : Elem, Decidable (x ≤ y)] (f g : Cont) : Decidable (f ≤ g) := Id.run do
    let mut le : Bool := true
    for (x,_) in Enumtype.fullRange Idx do
      if ¬(f[x] ≤ g[x]) then
        le := false
        break
    if le then isTrue sorry else isFalse sorry

end Operations

end ArrayType

namespace ArrayType

  variable {Cont : Nat → Type} {Elem : Type |> outParam}
  variable [LinearArrayType Cont Elem]

  def empty : Cont 0 := introElem λ i =>
    absurd (a := ∃ n : Nat, n < 0)
           (Exists.intro i.1 i.2)
           (by intro h; have h' := h.choose_spec; cases h'; done)

  def split {n m : Nat} (x : Cont (n+m)) : Cont n × Cont m :=
    (introElem λ i => x[⟨i.1,sorry_proof⟩],
     introElem λ i => x[⟨i.1+n,sorry_proof⟩])

  def append {n m : Nat} (x : Cont n) (y : Cont m) : Cont (n+m) :=
    introElem λ i =>
      if i.1 < n
      then x[⟨i.1,sorry_proof⟩]
      else y[⟨i.1-n, sorry_proof⟩]

end ArrayType


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Eric Wieser
-/
import linear_algebra.span
import linear_algebra.bilinear_map

/-!
# Images of pairs of submodules under bilinear maps

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file provides `submodule.map₂`, which is later used to implement `submodule.has_mul`.

## Main results

* `submodule.map₂_eq_span_image2`: the image of two submodules under a bilinear map is the span of
  their `set.image2`.

## Notes

This file is quite similar to the n-ary section of `data.set.basic` and to `order.filter.n_ary`.
Please keep them in sync.
-/

universes uι u v

open set
open_locale big_operators
open_locale pointwise

namespace submodule

variables {ι : Sort uι} {R M N P : Type*}
variables [comm_semiring R] [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
variables [module R M] [module R N] [module R P]

/-- Map a pair of submodules under a bilinear map.

This is the submodule version of `set.image2`.  -/
def map₂ (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) : submodule R P :=
⨆ s : p, q.map $ f s

theorem apply_mem_map₂ (f : M →ₗ[R] N →ₗ[R] P) {m : M} {n : N}
  {p : submodule R M} {q : submodule R N} (hm : m ∈ p) (hn : n ∈ q) : f m n ∈ map₂ f p q :=
(le_supr _ ⟨m, hm⟩ : _ ≤ map₂ f p q) ⟨n, hn, rfl⟩

theorem map₂_le {f : M →ₗ[R] N →ₗ[R] P}
  {p : submodule R M} {q : submodule R N} {r : submodule R P} :
  map₂ f p q ≤ r ↔ ∀ (m ∈ p) (n ∈ q), f m n ∈ r :=
⟨λ H m hm n hn, H $ apply_mem_map₂ _ hm hn,
 λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩

variables R
theorem map₂_span_span (f : M →ₗ[R] N →ₗ[R] P) (s : set M) (t : set N) :
  map₂ f (span R s) (span R t) = span R (set.image2 (λ m n, f m n) s t) :=
begin
  apply le_antisymm,
  { rw map₂_le, intros a ha b hb,
    apply span_induction ha,
    work_on_goal 1 { intros, apply span_induction hb,
      work_on_goal 1 { intros, exact subset_span ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
    all_goals {
      intros,
      simp only [linear_map.map_zero, linear_map.zero_apply, zero_mem,
        linear_map.map_add, linear_map.add_apply, linear_map.map_smul, linear_map.smul_apply] },
    all_goals {
      solve_by_elim [add_mem _ _, zero_mem _, smul_mem _ _ _]
        { max_depth := 4, discharger := tactic.interactive.apply_instance } } },
  { rw span_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
    exact apply_mem_map₂ _ (subset_span ha) (subset_span hb) }
end
variables {R}

@[simp] theorem map₂_bot_right (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) : map₂ f p ⊥ = ⊥ :=
eq_bot_iff.2 $ map₂_le.2 $ λ m hm n hn,
  by { rw [submodule.mem_bot] at hn ⊢, rw [hn, linear_map.map_zero] }

@[simp] theorem map₂_bot_left (f : M →ₗ[R] N →ₗ[R] P) (q : submodule R N) : map₂ f ⊥ q = ⊥ :=
eq_bot_iff.2 $ map₂_le.2 $ λ m hm n hn,
  by { rw [submodule.mem_bot] at hm ⊢, rw [hm, linear_map.map_zero₂] }

@[mono] theorem map₂_le_map₂ {f : M →ₗ[R] N →ₗ[R] P}
  {p₁ p₂ : submodule R M} {q₁ q₂ : submodule R N} (hp : p₁ ≤ p₂) (hq : q₁ ≤ q₂) :
  map₂ f p₁ q₁ ≤ map₂ f p₂ q₂ :=
map₂_le.2 $ λ m hm n hn, apply_mem_map₂ _ (hp hm) (hq hn)

theorem map₂_le_map₂_left {f : M →ₗ[R] N →ₗ[R] P}
  {p₁ p₂ : submodule R M} {q : submodule R N} (h : p₁ ≤ p₂) : map₂ f p₁ q ≤ map₂ f p₂ q :=
map₂_le_map₂ h (le_refl q)

theorem map₂_le_map₂_right {f : M →ₗ[R] N →ₗ[R] P}
  {p : submodule R M} {q₁ q₂ : submodule R N} (h : q₁ ≤ q₂): map₂ f p q₁ ≤ map₂ f p q₂ :=
map₂_le_map₂ (le_refl p) h

theorem map₂_sup_right (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q₁ q₂ : submodule R N) :
  map₂ f p (q₁ ⊔ q₂) = map₂ f p q₁ ⊔ map₂ f p q₂ :=
le_antisymm (map₂_le.2 $ λ m hm np hnp, let ⟨n, hn, p, hp, hnp⟩ := mem_sup.1 hnp in
  mem_sup.2 ⟨_, apply_mem_map₂ _ hm hn, _, apply_mem_map₂ _ hm hp, hnp ▸ (map_add _ _ _).symm⟩)
(sup_le (map₂_le_map₂_right le_sup_left) (map₂_le_map₂_right le_sup_right))

theorem map₂_sup_left (f : M →ₗ[R] N →ₗ[R] P) (p₁ p₂ : submodule R M) (q : submodule R N) :
  map₂ f (p₁ ⊔ p₂) q = map₂ f p₁ q ⊔ map₂ f p₂ q :=
le_antisymm (map₂_le.2 $ λ mn hmn p hp, let ⟨m, hm, n, hn, hmn⟩ := mem_sup.1 hmn in
  mem_sup.2 ⟨_, apply_mem_map₂ _ hm hp, _, apply_mem_map₂ _ hn hp,
    hmn ▸ (linear_map.map_add₂ _ _ _ _).symm⟩)
(sup_le (map₂_le_map₂_left le_sup_left) (map₂_le_map₂_left le_sup_right))

lemma image2_subset_map₂ (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) :
  set.image2 (λ m n, f m n) (↑p : set M) (↑q : set N) ⊆ (↑(map₂ f p q) : set P) :=
by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact apply_mem_map₂ _ hi hj }

lemma map₂_eq_span_image2 (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) :
  map₂ f p q = span R (set.image2 (λ m n, f m n) (p : set M) (q : set N)) :=
by rw [← map₂_span_span, span_eq, span_eq]

lemma map₂_flip (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) :
  map₂ f.flip q p = map₂ f p q :=
by { rw [map₂_eq_span_image2, map₂_eq_span_image2, set.image2_swap], refl }

lemma map₂_supr_right (f : M →ₗ[R] N →ₗ[R] P) (s : submodule R M) (t : ι → submodule R N) :
  map₂ f s (⨆ i, t i) = ⨆ i, map₂ f s (t i) :=
begin
  suffices :
    map₂ f (span R s) (⨆ i, span R (t i : set N)) = (⨆ i, map₂ f (span R s) (span R (t i))),
  { simpa only [span_eq] using this },
  simp_rw [map₂_span_span, ← span_Union, map₂_span_span, set.image2_Union_right],
end

theorem map₂_span_singleton_eq_map (f : M →ₗ[R] N →ₗ[R] P) (m : M) :
  map₂ f (span R {m}) = map (f m) :=
begin
  funext, rw map₂_eq_span_image2, apply le_antisymm,
  { rw [span_le, set.image2_subset_iff],
    intros x hx y hy,
    obtain ⟨a, rfl⟩ := mem_span_singleton.1 hx,
    rw [f.map_smul],
    exact smul_mem _ a (mem_map_of_mem hy) },
  { rintro _ ⟨n, hn, rfl⟩,
    exact subset_span ⟨m, n, mem_span_singleton_self m, hn, rfl⟩ },
end

theorem map₂_span_singleton_eq_map_flip (f : M →ₗ[R] N →ₗ[R] P) (s : submodule R M) (n : N) :
  map₂ f s (span R {n}) = map (f.flip n) s :=
by rw [← map₂_span_singleton_eq_map, map₂_flip]

end submodule