import category_theory.limits.preserves.basic
import set_theory.ordinal

open category_theory category_theory.limits category_theory.functor

universes v₁ v₂ u₁ u₂

structure colimit (𝒞 : Type 1) [category.{0} 𝒞] : Type 1 :=
( diag : Type )
[ category : category.{0} diag ]
( F : diag ⥤ 𝒞 )
( colimit_cocone : colimit_cocone F )

attribute [instance] colimit.category

constant fixing_cocompletion {𝒞 : Type 1} [category.{0} 𝒞] {ι : Type 1} (colimits : ι → colimit 𝒞) : Type 1

namespace fixing_cocompletion

variables {𝒞 : Type 1} [category.{0} 𝒞] {ι : Type 1} (colimits : ι → colimit 𝒞)

@[instance] protected constant category : category.{0} (fixing_cocompletion colimits)

@[instance] protected constant has_colimits : has_colimits_of_size.{0 0} (fixing_cocompletion colimits)

constant of_cat : 𝒞 ⥤ fixing_cocompletion colimits

constant of_cat_preserves : Π i : ι, preserves_colimit (colimits i).F (of_cat colimits)

variable {colimits}

constant extend {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_colimit (colimits i).F F) : fixing_cocompletion colimits ⥤ 𝒟

constant extend_preserves {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_colimit (colimits i).F F) :
  preserves_colimits.{0 0} (extend F hF)

constant of_cat_extend {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_colimit (colimits i).F F) :
  of_cat colimits ⋙ extend F hF ≅ F

constant extend_unique {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_colimit (colimits i).F F)
  (G : fixing_cocompletion colimits ⥤ 𝒟)
  (hG : preserves_colimits.{0 0} (extend F hF))
  (hG_commutes : of_cat colimits ⋙ G ≅ F) :
  G ≅ extend F hF

end fixing_cocompletion

structure limit (𝒞 : Type 1) [category.{0} 𝒞] : Type 1 :=
( diag : Type )
[ category : category.{0} diag ]
( F : diag ⥤ 𝒞 )
( limit_cone : limit_cone F )

attribute [instance] limit.category

constant fixing_completion {𝒞 : Type 1} [category.{0} 𝒞] {ι : Type 1} (limits : ι → limit 𝒞) : Type 1

namespace fixing_completion

variables {𝒞 : Type 1} [category.{0} 𝒞] {ι : Type 1} (limits : ι → limit 𝒞)

@[instance] protected constant category : category.{0} (fixing_completion limits)

@[instance] protected constant has_limits : has_limits_of_size.{0 0} (fixing_completion limits)

constant of_cat : 𝒞 ⥤ fixing_completion limits

constant of_cat_preserves : Π i : ι, preserves_limit (limits i).F (of_cat limits)

variable {limits}

constant extend {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_limit (limits i).F F) : fixing_completion limits ⥤ 𝒟

constant extend_preserves {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_limit (limits i).F F) :
  preserves_colimits.{0 0} (extend F hF)

constant of_cat_extend {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_limit (limits i).F F) :
  of_cat limits ⋙ extend F hF ≅ F

constant extend_unique {𝒟 : Type 1} [category.{0} 𝒟] (F : 𝒞 ⥤ 𝒟)
  (hF : Π i : ι, preserves_limit (limits i).F F)
  (G : fixing_completion limits ⥤ 𝒟)
  (hG : preserves_colimits.{0 0} (extend F hF))
  (hG_commutes : of_cat limits ⋙ G ≅ F) :
  G ≅ extend F hF

end fixing_completion

namespace totally_ordered_colimit

structure ordinal_seq : Type 2 :=
( α : Type )
[ linear_order : linear_order α ]
( obj : Π i : α, Type 1 )
[ cat : Π i, category.{0} (obj i) ]
( map : Π i j : α, i ≤ j → (obj i ⥤ obj j) )
[ full : Π (i j : α) (hij : i ≤ j), full (map i j hij) ]
[ faithful : Π (i j : α) (hij : i ≤ j), faithful (map i j hij) ]
( map_id : Π i, map i i le_rfl ≅ 𝟭 (obj i) )
( map_comp : Π i j k (hij : i ≤ j) (hjk : j ≤ k),
    map i k (le_trans hij hjk) ≅ map i j hij ⋙ map j k hjk )
-- ( map_comp_comp : Π (i j k l) (hij : i ≤ j) (hjk : j ≤ k) (hkl : k ≤ l),
--     map_comp  )

attribute [instance] ordinal_seq.linear_order ordinal_seq.cat ordinal_seq.full ordinal_seq.faithful

def totally_ordered_colimit (a : ordinal_seq) : Type* :=
Σ i : a.α, a.obj i

namespace totally_ordered_colimit

variables {a : ordinal_seq}

@[ext] protected structure hom (X Y : totally_ordered_colimit a) : Type :=
( le : X.1 ≤ Y.1 )
( hom : (a.map X.1 Y.1 le).obj X.2 ⟶ Y.2 )

protected def comp (X Y Z : totally_ordered_colimit a) (f : X.hom Y) (g : Y.hom Z) : X.hom Z :=
⟨le_trans f.1 g.1,
  (a.map_comp X.1 Y.1 Z.1 f.1 g.1).hom.app _ ≫ ((a.map _ _ g.1).map f.2 ≫ g.2)⟩

instance : category_struct (totally_ordered_colimit a) :=
{ hom := totally_ordered_colimit.hom,
  id := λ X, ⟨le_refl _, (a.map_id X.1).hom.app _⟩,
  comp := totally_ordered_colimit.comp }

lemma comp_def {X Y Z : totally_ordered_colimit a} (f : X ⟶ Y) (g : Y ⟶ Z) :
  f ≫ g = X.comp Y Z f g := rfl

lemma id_def (X : totally_ordered_colimit a) :
  𝟙 X = ⟨le_refl _, (a.map_id X.1).hom.app _⟩ := rfl

instance : category (totally_ordered_colimit a) :=
{ comp_id' := begin
    intros,
    simp [comp_def, totally_ordered_colimit.comp, id_def],
    ext,
    simp,
    admit
  end,
  id_comp' := begin
    intros,
    simp [comp_def, totally_ordered_colimit.comp, id_def],
    ext,
    simp,
    admit
  end,
  assoc' := begin
    intros W X Y Z f g h,
    simp [comp_def, totally_ordered_colimit.comp, id_def],
    ext,
    simp,
    admit
  end }

def UMP

-- def orthogonal {𝒞 : Type u₁} [category.{v₁} 𝒞] {𝒟 : Type u₂} [category.{v₂} 𝒟]
--   (D : 𝒟 ⥤ 𝒞) (c : cone D) (X : 𝒞) : Type* :=
-- Π d : (const 𝒟).obj X ⟶ D,
--     { f : X ⟶ c.X // ∀ (A : 𝒟), f ≫ c.π.app A = nat_trans.app d A ∧
--       ∀ g : X ⟶ c.X, (∀ (A : 𝒟), f ≫ c.π.app A = nat_trans.app d A) → f = g }

-- def fixing_cocompletion {ι : Type} (D : ι → Type)
--   [Π i, category.{0} (D i)] (F : Π i, D i ⥤ 𝒞) : Type* :=
--   Σ X : 𝒞ᵒᵖ ⥤ Type, ∀ (i : ι) (c : limit_cone (F i)),
--     orthogonal (F i ⋙ (@yoneda 𝒞 _)) ((cones.functoriality (F i) yoneda).obj c.cone) X

-- namespace fixing_cocompletion

-- variables {ι : Type} (D : ι → Type)
--   [Π i, category.{0} (D i)] (F : Π i, D i ⥤ 𝒞)

-- instance : category_struct (fixing_cocompletion D F) :=
-- { hom := λ X Y, X.1 ⟶ Y.1,
--   id := λ X, 𝟙 X.fst,
--   comp := λ X Y Z f g, f ≫ g }

-- instance : category (fixing_cocompletion D F) := {}

-- def of_cat : 𝒞 ⥤ fixing_cocompletion D F :=
-- { obj := λ X, ⟨yoneda.obj X, λ i c d, sorry⟩,
--   map := λ X Y f, yoneda.map f }

-- def preserves_limit

end totally_ordered_colimit


example : (λ (u : Nat) => u + 0) = id :=by
  conv =>
    lhs
    intro u
    change u


import category_theory.preadditive.functor_category
import category_theory.limits.shapes.finite_products
import category_theory.limits.shapes.biproducts
import category_theory.limits.preserves.filtered

import for_mathlib.homological_complex2
import for_mathlib.additive_functor

import breen_deligne.homotopy

noncomputable theory

open_locale big_operators

open category_theory category_theory.limits

namespace category_theory
namespace preadditive

variables {𝒜 : Type*} [category 𝒜] [has_zero_morphisms 𝒜] [has_finite_biproducts 𝒜]

-- move this
@[simps {fully_applied := ff}]
def Pow (n : ℕ) : 𝒜 ⥤ 𝒜 :=
{ obj := λ A, ⨁ (λ (i : ulift $ fin n), A),
  map := λ A B f, biproduct.map (λ i, f),
  map_id' := λ A, by { ext i j, simp only [biproduct.ι_map, category.id_comp, category.comp_id], },
  map_comp' := λ A B C f g, by { ext i j, simp only [biproduct.ι_map_assoc, category.assoc], } }

-- move this
attribute [simps] comp_hom
.

instance (n : ℕ) {J : Type*} [category J] : preserves_colimits_of_shape J (Pow n : 𝒜 ⥤ 𝒜) :=
{ preserves_colimit := λ K,
  { preserves := λ c hc,
    { desc := λ s, biproduct.desc $ λ i,
        let t : cocone K :=
        { X := s.X,
          ι := { app := λ j, show K.obj j ⟶ (K ⋙ Pow n).obj j, from biproduct.ι _ i,
                naturality' := by intros X Y f;
                  simp only [functor.comp_map, Pow_map, biproduct.ι_map], } ≫ s.ι } in
        hc.desc t,
      fac' := begin
        intros, ext,
        simp only [Pow_map, functor.map_cocone_ι_app, biproduct.map_desc,
          is_colimit.fac, nat_trans.comp_app, biproduct.ι_desc],
      end,
      uniq' := begin
        intros, ext i,
        simp only [biproduct.ι_desc],
        let t : cocone K :=
        { X := s.X,
          ι := { app := λ j, show K.obj j ⟶ (K ⋙ Pow n).obj j, from biproduct.ι _ i,
                naturality' := by intros X Y f;
                  simp only [functor.comp_map, Pow_map, biproduct.ι_map], } ≫ s.ι },
        refine hc.uniq t (_ ≫ m) _,
        intro j,
        simp only [nat_trans.comp_app, ← w,
          functor.map_cocone_ι_app, Pow_map, biproduct.ι_map_assoc],
      end } } }

instance (n : ℕ) : preserves_colimits (Pow n : 𝒜 ⥤ 𝒜) :=
{ preserves_colimits_of_shape := λ J hJ, by apply_instance }

end preadditive
end category_theory

namespace homotopy

variables {ι 𝒜 : Type*} [category 𝒜] [preadditive 𝒜] {c : complex_shape ι}
variables {C D : homological_complex 𝒜 c} {f g : C ⟶ D}

@[simps]
def congr (h : homotopy f g) (f' g' : C ⟶ D) (hf : f = f') (hg : g = g') :
  homotopy f' g' :=
{ comm := by simpa only [hf, hg] using h.comm,
  .. h }

end homotopy

namespace breen_deligne

open category_theory.preadditive

variables (BD : data)
variables {𝒜 : Type*} [category 𝒜] [preadditive 𝒜] [has_finite_biproducts 𝒜]
variables (F : 𝒜 ⥤ 𝒜)

namespace basic_universal_map

variables {m n o : ℕ} (f : basic_universal_map m n) (g : basic_universal_map n o)

@[simps {fully_applied := ff}]
def eval_Pow : (Pow m : 𝒜 ⥤ 𝒜) ⟶ Pow n :=
{ app := λ A, biproduct.matrix (λ i j, f j.down i.down • 𝟙 A),
  naturality' := begin
    intros, ext i j,
    simp only [Pow_map, biproduct.ι_map_assoc, category.assoc, biproduct.matrix_π,
      biproduct.map_π, biproduct.ι_desc, biproduct.matrix_π_assoc, biproduct.ι_desc_assoc,
      comp_zsmul, zsmul_comp, category.comp_id, category.id_comp],
  end }

@[simp] lemma eval_Pow_comp : @eval_Pow 𝒜 _ _ _ _ _ (comp g f) = f.eval_Pow ≫ g.eval_Pow :=
begin
  ext A i j,
  simp only [eval_Pow_app, nat_trans.comp_app, category.assoc, biproduct.ι_map_assoc,
    biproduct.matrix_π, biproduct.ι_matrix_assoc, biproduct.lift_desc,
    biproduct.map_π, biproduct.ι_desc, biproduct.matrix_π_assoc, biproduct.ι_desc_assoc,
    comp_zsmul, zsmul_comp, category.comp_id, category.id_comp],
  simp only [comp, add_monoid_hom.mk'_apply, matrix.mul, matrix.dot_product,
    finset.sum_smul, mul_smul],
  rw [← (@equiv.ulift (fin n)).symm.sum_comp, finset.sum_congr rfl],
  rintros j -,
  rw smul_comm, refl,
end

end basic_universal_map

namespace universal_map

variables {m n o : ℕ} (f : universal_map m n) (g : universal_map n o)

/- Note: this definition is generalized in `eval1half.lean` for a functor
`F : A₁ ⥤ A₂`. This generalization is used in `apply_Pow.lean`. -/
def eval_Pow : universal_map m n →+ (Pow m ⋙ F ⟶ Pow n ⋙ F) :=
free_abelian_group.lift $ λ g : basic_universal_map m n, whisker_right g.eval_Pow F

lemma eval_Pow_of (g : basic_universal_map m n) :
  eval_Pow F (free_abelian_group.of g) = whisker_right g.eval_Pow F :=
free_abelian_group.lift.of _ _

@[simp] lemma eval_Pow_zero : eval_Pow F (0 : universal_map m n) = 0 :=
add_monoid_hom.map_zero _

lemma eval_Pow_zero_app (A : 𝒜) : (eval_Pow F (0 : universal_map m n)).app A = 0 :=
by rw [eval_Pow_zero, zero_app]

lemma eval_Pow_comp : eval_Pow F (universal_map.comp g f) = eval_Pow F f ≫ eval_Pow F g :=
begin
  rw [← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_hom_apply_apply,
    ← add_monoid_hom.comp_apply, eq_comm,
    ← category_theory.preadditive.comp_hom_apply_apply, ← add_monoid_hom.flip_apply,
    ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_hom_apply_apply,
    ← add_monoid_hom.flip_apply _ _ (eval_Pow F),
    ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_hom_apply_apply,
    ← add_monoid_hom.comp_apply, ← add_monoid_hom.comp_hom_apply_apply],
  congr' 2,
  clear f g,
  ext g f : 2,
  simp only [add_monoid_hom.comp_hom_apply_apply, add_monoid_hom.comp_apply,
    add_monoid_hom.flip_apply, category_theory.preadditive.comp_hom_apply_apply,
    comp_of, eval_Pow_of, whisker_right_comp, basic_universal_map.eval_Pow_comp],
end

lemma eval_Pow_comp_app (A : 𝒜) :
  (eval_Pow F (universal_map.comp g f)).app A = (eval_Pow F f).app A ≫ (eval_Pow F g).app A :=
by rw [eval_Pow_comp, nat_trans.comp_app]

@[simps {fully_applied := ff}]
def eval_Pow_functor : FreeMat ⥤ (𝒜 ⥤ 𝒜) :=
{ obj := λ n, Pow n ⋙ F,
  map := λ m n f, eval_Pow F f,
  map_id' := λ n,
  begin
    refine (eval_Pow_of F _).trans _,
    ext A : 2, dsimp,
    rw ← F.map_id, congr' 1,
    ext i j : 2,
    simp only [biproduct.ι_matrix, category.comp_id, biproduct.lift_π, basic_universal_map.id],
    rw biproduct.ι_π,
    split_ifs with hij,
    { cases hij, rw [matrix.one_apply_eq, one_smul, eq_to_hom_refl], },
    { rw [matrix.one_apply_ne, zero_smul], cases i, cases j, dsimp, rintro rfl, exact hij rfl }
  end,
  map_comp' := λ m n o f g, eval_Pow_comp F _ _ }

instance eval_Pow_functor_additive : (eval_Pow_functor F).additive :=
{ map_add' := λ m n f g, by { dsimp [eval_Pow], rw add_monoid_hom.map_add } }

end universal_map

namespace data

open universal_map

@[simps {fully_applied := ff}]
def eval_functor' : data ⥤ chain_complex (𝒜 ⥤ 𝒜) ℕ :=
(eval_Pow_functor F).map_homological_complex _

@[simps {fully_applied := ff}]
def eval_functor : data ⥤ 𝒜 ⥤ chain_complex 𝒜 ℕ :=
eval_functor' F ⋙ homological_complex.functor_eval.flip
.

-- generalize to arbitrary homological complexes
instance homological_complex.functor_eval_flip_preserves_colimits_of_shape
  (J : Type*) [category J] (F : chain_complex (𝒜 ⥤ 𝒜) ℕ)
  [∀ i, preserves_colimits_of_shape J (F.X i)] :
  preserves_colimits_of_shape J (homological_complex.functor_eval.flip.obj F) :=
{ preserves_colimit := λ K,
  { preserves := λ c hc,
    let t : Π (s : cocone (K ⋙ homological_complex.functor_eval.flip.obj F))
        (i : ℕ), cocone (K ⋙ F.X i) := λ s i,
    { X := s.X.X i,
      ι := { app := λ j, show (K ⋙ F.X i).obj j ⟶ s.X.X i, from (s.ι.app j).f i,
            naturality' := begin
              intros a b φ, have := s.ι.naturality φ, dsimp at this ⊢,
              simp only [category.comp_id] at this ⊢,
              rw ← this, refl
            end } },
      u : Π (s : cocone (K ⋙ homological_complex.functor_eval.flip.obj F))
        (i j : ℕ), cocone (K ⋙ F.X i) := λ s i j,
    { X := s.X.X j,
      ι := { app := λ k, show (K ⋙ F.X i).obj k ⟶ s.X.X j,
                         from (whisker_left K (F.d i j)).app k ≫ (s.ι.app k).f j,
            naturality' := begin
              intros a b φ, have := s.ι.naturality φ, dsimp at this ⊢,
              simp only [category.comp_id] at this ⊢,
              rw [← this, (F.d i j).naturality_assoc], refl,
            end } } in
    { desc := λ s,
      { f := λ i, (is_colimit_of_preserves (F.X i) hc).desc (t s i),
        comm' := begin
          intros i j h, dsimp,
          have := (is_colimit_of_preserves (F.X i) hc).uniq (u s i j),
          refine (this _ _).trans (this _ _).symm,
          { intros j', dsimp,
            erw [(is_colimit_of_preserves (F.X i) hc).fac_assoc],
            apply (s.ι.app j').comm, },
          { intros j', dsimp,
            rw nat_trans.naturality_assoc,
            erw [(is_colimit_of_preserves (F.X j) hc).fac], }
        end },
      fac' := by { intros, ext i, dsimp, erw [(is_colimit_of_preserves (F.X i) hc).fac], },
      uniq' := begin
        intros, ext i,
        exact (is_colimit_of_preserves (F.X i) hc).uniq (t s i) (m.f i)
          (λ j, homological_complex.congr_hom (w j) i),
      end, } } }

instance eval_functor_preserves_colimits_of_shape
  (BD : data) (J : Type*) [category J] [preserves_colimits_of_shape J F] :
  preserves_colimits_of_shape J ((eval_functor F).obj BD) :=
begin
  refine @homological_complex.functor_eval_flip_preserves_colimits_of_shape _ _ _ _ J _
    ((eval_functor' F).obj BD) (id _),
  intro i,
  show preserves_colimits_of_shape J (Pow (BD.X i) ⋙ F),
  apply_instance
end

instance eval_functor_preserves_filtered_colimits (BD : data) [preserves_filtered_colimits F] :
  preserves_filtered_colimits ((eval_functor F).obj BD) :=
{ preserves_filtered_colimits := by introsI; apply_instance }

-- @[simps]
-- def eval_functor.obj (M : 𝒜) : chain_complex 𝒜 ℕ :=
-- { X := λ n, (Pow (BD.X n) ⋙ F).obj M,
--   d := λ m n, (eval_Pow F (BD.d m n)).app M,
--   shape' := λ i j h, by rw [BD.shape i j h, universal_map.eval_Pow_zero_app],
--   d_comp_d' := λ i j k hij hjk, begin
--     rw [← universal_map.eval_Pow_comp_app],
--     have := BD.d_comp_d i j k,
--     convert universal_map.eval_Pow_zero_app _ _ using 3,
--   end }

-- @[simps {fully_applied := ff}]
-- def eval_functor : 𝒜 ⥤ chain_complex 𝒜 ℕ :=
-- { obj := eval_functor.obj BD F,
--   map := λ A B f,
--   { f := λ n, (Pow (BD.X n) ⋙ F).map f,
--     comm' := λ m n h, by simp only [eval_functor.obj_d, nat_trans.naturality] },
--   map_id' := λ A, by { ext n, exact category_theory.functor.map_id _ _ },
--   map_comp' := λ A B C f g, by { ext n, exact category_theory.functor.map_comp _ _ _ } }

-- @[simps {fully_applied := ff}]
-- def map_eval_functor {BD₁ BD₂ : data} (φ : BD₁ ⟶ BD₂) :
--   BD₁.eval_functor F ⟶ BD₂.eval_functor F :=
-- { app := λ A,
--   { f := λ i, (universal_map.eval_Pow F (φ.f i)).app A,
--     comm' := by { intros, dsimp only [eval_functor_obj, eval_functor.obj_d],
--       simp only [← nat_trans.comp_app, ← eval_Pow_comp F], congr' 2, apply φ.comm } },
--   naturality' := λ A B f, by { ext i : 2, apply nat_trans.naturality } }

end data

namespace package

open universal_map

variables (BD' : package) (A : 𝒜)

def eval_homotopy := (eval_Pow_functor F).map_homotopy BD'.homotopy

def eval_homotopy' (A : 𝒜) :=
(eval_Pow_functor F ⋙ (evaluation _ _).obj A).map_homotopy BD'.homotopy

local attribute [instance] has_binary_biproducts_of_finite_biproducts

@[simps]
def Biprod : 𝒜 ⥤ 𝒜 :=
{ obj := λ A, A ⊞ A,
  map := λ A B f, biprod.map f f,
  map_id' := λ A,
    by ext; simp only [biprod.inl_map, biprod.inr_map, category.id_comp, category.comp_id],
  map_comp' := λ A B C f g,
    by ext; simp only [biprod.inl_map_assoc, biprod.inr_map_assoc, category.assoc] }
.

@[simps {fully_applied := ff}]
def Biprod_iso_Pow_two_components (A : 𝒜) : A ⊞ A ≅ (Pow 2).obj A :=
{ hom := biprod.desc
    (biproduct.ι (λ i : ulift (fin 2), A) ⟨0⟩)
    (biproduct.ι (λ i : ulift (fin 2), A) ⟨1⟩),
  inv := biprod.lift (biproduct.π _ ⟨0⟩) (biproduct.π _ ⟨1⟩),
  hom_inv_id' := begin
    ext;
    simp only [biprod.lift_fst, biprod.lift_snd, biprod.inl_desc_assoc, biprod.inr_desc_assoc,
      biproduct.ι_π_self, category.assoc];
    erw category.id_comp;
    simp only [biprod.inl_fst, biprod.inl_snd, biprod.inr_fst, biprod.inr_snd];
    rw [biproduct.ι_π_ne]; dec_trivial
  end,
  inv_hom_id' := begin
    ext ⟨i⟩ ⟨j⟩,
    erw [category.comp_id],
    simp only [add_comp, comp_add, biprod.lift_desc, category.assoc],
    fin_cases i with [0,1];
    rw [biproduct.ι_π_self_assoc, biproduct.ι_π_ne_assoc, zero_comp],
    swap 2, { dec_trivial },
    swap 3, { dec_trivial },
    { rw add_zero },
    { rw zero_add }
  end }
.

@[simps {fully_applied := ff}]
def Biprod_iso_Pow_two : (Biprod : 𝒜 ⥤ 𝒜) ≅ Pow 2 :=
nat_iso.of_components Biprod_iso_Pow_two_components $ λ A B f,
begin
  ext ⟨i⟩;
  simp only [biproduct.ι_map, Biprod_iso_Pow_two_components_hom, Biprod_map, Pow_map,
    biprod.inl_map_assoc, biprod.inl_desc_assoc, biprod.inr_map_assoc, biprod.inr_desc_assoc,
    biprod.inr_map, category.assoc, biprod.inr_desc],
end
.

@[simp] lemma _root_.ulift.up_inj {α : Type*} (a b : α) : ulift.up a = ulift.up b ↔ a = b :=
⟨congr_arg ulift.down, congr_arg ulift.up⟩

@[simps]
def Pow_comp_Pow_components (m n : ℕ) (A : 𝒜) :
  (Pow n).obj ((Pow m).obj A) ≅ (Pow (m * n)).obj A :=
{ hom := biproduct.desc $ λ j, biproduct.desc $ λ i,
    biproduct.ι (λ i : ulift (fin _), A) ⟨fin_prod_fin_equiv (i.down, j.down)⟩,
  inv := biproduct.lift $ λ j, biproduct.lift $ λ i,
    biproduct.π (λ i : ulift (fin _), A) ⟨fin_prod_fin_equiv (i.down, j.down)⟩,
  hom_inv_id' := begin
    ext ⟨j⟩ ⟨i⟩ ⟨j'⟩ ⟨i'⟩ : 4,
    erw [biproduct.ι_desc_assoc, category.comp_id],
    simp only [biproduct.ι_desc_assoc, category.assoc, biproduct.lift_π],
    by_cases hj : j = j',
    { subst hj, rw [biproduct.ι_π_self_assoc],
      by_cases hi : i = i',
      { subst hi, rw [biproduct.ι_π_self, biproduct.ι_π_self] },
      { rw [biproduct.ι_π_ne, biproduct.ι_π_ne],
        { exact mt (congr_arg ulift.down) hi },
        { simpa only [equiv.apply_eq_iff_eq, and_true, prod.mk.inj_iff, eq_self_iff_true,
            ulift.up_inj, ne.def] using hi, } } },
    { rw [biproduct.ι_π_ne, biproduct.ι_π_ne_assoc, zero_comp, comp_zero],
      { exact mt (congr_arg ulift.down) hj },
      { simp only [equiv.apply_eq_iff_eq, prod.mk.inj_iff, _root_.ulift.up_inj, ne.def, hj,
          not_false_iff, and_false], } }
  end,
  inv_hom_id' := begin
    ext ⟨k⟩ ⟨k'⟩ : 2,
    erw [category.comp_id],
    simp only [category.assoc, biproduct.lift_desc, sum_comp, comp_sum],
    by_cases h : k = k',
    { subst h,
      rw [biproduct.ι_π_self,
        finset.sum_eq_single (⟨(fin_prod_fin_equiv.symm k).snd⟩ : ulift (fin _)),
        finset.sum_eq_single (⟨(fin_prod_fin_equiv.symm k).fst⟩ : ulift (fin _))],
      { dsimp [- fin_prod_fin_equiv_symm_apply],
        rw [prod.mk.eta, equiv.apply_symm_apply, biproduct.ι_π_self, biproduct.ι_π_self_assoc], },
      { rintro ⟨i⟩ - hi,
        rw [biproduct.ι_π_ne_assoc, zero_comp],
        dsimp [- fin_prod_fin_equiv_symm_apply],
        simp only [ulift.up_inj, ne.def, ← equiv.symm_apply_eq,
          prod.ext_iff, not_and_distrib] at hi ⊢,
        exact or.inl (ne.symm hi) },
      { intro h, exact (h (finset.mem_univ _)).elim },
      { rintro ⟨j⟩ - hj,
        rw finset.sum_eq_zero,
        rintro ⟨i⟩ -,
        rw [biproduct.ι_π_ne_assoc, zero_comp],
        dsimp [- fin_prod_fin_equiv_symm_apply],
        simp only [ulift.up_inj, ne.def, ← equiv.symm_apply_eq,
          prod.ext_iff, not_and_distrib] at hj ⊢,
        exact or.inr (ne.symm hj) },
      { intro h, exact (h (finset.mem_univ _)).elim } },
    { rw [biproduct.ι_π_ne, finset.sum_eq_zero],
      { rintro ⟨j⟩ -,
        rw [finset.sum_eq_zero],
        rintro ⟨i⟩ -,
        by_cases hk : k = fin_prod_fin_equiv (i,j),
        { subst hk,
          rw [biproduct.ι_π_self_assoc, biproduct.ι_π_ne],
          simpa only [ulift.up_inj, ne.def] using h, },
        { rw [biproduct.ι_π_ne_assoc, zero_comp],
          dsimp [- fin_prod_fin_equiv_symm_apply],
          simpa only [ulift.up_inj, ne.def] using h, } },
      { rw [ne.def, ulift.up_inj], exact h } },
  end }
.

@[simps {fully_applied := ff}]
def Pow_comp_Pow (m n : ℕ) : (Pow m ⋙ Pow n : 𝒜 ⥤ 𝒜) ≅ Pow (m * n) :=
nat_iso.of_components (Pow_comp_Pow_components m n) $ λ A B f,
begin
  ext ⟨j⟩ ⟨i⟩ ⟨k⟩,
  simp only [biproduct.ι_map, Pow_comp_Pow_components_hom, Pow_map, functor.comp_map,
    biproduct.ι_map_assoc, category.assoc, biproduct.map_π, biproduct.ι_desc_assoc],
end
.

lemma _root_.free_abelian_group.eq_zero_induction
  {α M : Type*} [add_group M] (f : free_abelian_group α → M)
  (h1 : ∀ a, f (free_abelian_group.of a) = 0) (h2 : ∀ x y, f (x + y) = f x + f y) :
  ∀ x, f x = 0 :=
begin
  let F := add_monoid_hom.mk' f h2,
  have hF : ∀ x, F x = f x := λ _, rfl,
  intro x,
  refine free_abelian_group.induction_on x _ h1 _ _,
  { exact F.map_zero },
  { intros, show F _ = 0, rw [F.map_neg, hF, h1, neg_zero], },
  { intros x y hx hy, show F _ = 0, rw [F.map_add, hF, hF, hx, hy, add_zero], },
end

lemma aux' (m n : ℕ) (f : universal_map m n) :
  F.map ((Pow_comp_Pow 2 m).inv.app A ≫ (Pow m).map (Biprod_iso_Pow_two.inv.app A)) ≫
    ((eval_Pow_functor F).map f).app (Biprod.obj A) =
  ((eval_Pow_functor F).map ((mul 2) f)).app A ≫ F.map ((Pow_comp_Pow 2 n).inv.app A ≫
    (Pow n).map (Biprod_iso_Pow_two.inv.app A)) :=
begin
  rw [← sub_eq_zero],
  refine free_abelian_group.eq_zero_induction _ _ _ f; clear f,
  { intro f,
    rw [sub_eq_zero],
    dsimp only [eval_Pow_functor],
    rw [mul_of, eval_Pow_of, eval_Pow_of],
    dsimp only [whisker_right_app, basic_universal_map.eval_Pow_app],
    rw [← F.map_comp, ← F.map_comp],
    congr' 1,
    dsimp only [Pow_comp_Pow, Biprod_iso_Pow_two],
    erw [nat_iso.of_components.inv_app, nat_iso.of_components.inv_app,
      nat_iso.of_components.inv_app],
    dsimp only [Pow_comp_Pow_components_inv, Biprod_iso_Pow_two_components_inv, Pow_map],
    apply category_theory.limits.biproduct.hom_ext,
    rintro ⟨j⟩,
    apply category_theory.limits.biproduct.hom_ext',
    refine equiv.ulift.forall_congr_left'.mpr _,
    refine fin_prod_fin_equiv.forall_congr_left.mp _,
    rintro ⟨b, i⟩,
    rw [biproduct.lift_map, biproduct.lift_matrix, biproduct.lift_π, comp_sum,
      biproduct.lift_map, category.assoc, biproduct.ι_matrix_assoc, biproduct.lift_π],
    rw [finset.sum_eq_single (⟨i⟩ : ulift (fin m)),
      equiv.ulift_symm_apply, ulift.down_up, ulift.down_up, ulift.down_up],
    { rw [category.assoc],
      ext;
      rw [category.assoc, category.assoc, comp_zsmul, zsmul_comp, comp_zsmul, comp_zsmul,
        category.comp_id, category.assoc, category.assoc];
      [rw biprod.lift_fst, rw biprod.lift_snd];
      rw [biproduct.lift_π, biproduct.lift_π, biproduct.lift_π,
        biproduct.ι_π, basic_universal_map.mul_apply, matrix.reindex_linear_equiv_apply,
        matrix.reindex_apply, matrix.minor_apply, ulift.down_up, ulift.down_up,
        matrix.kronecker_map, equiv.symm_apply_apply, equiv.symm_apply_apply];
      simp only [dite_eq_ite, equiv.apply_eq_iff_eq, and_true, prod.mk.inj_iff,
        eq_self_iff_true, ulift.up_inj, eq_to_hom_refl, matrix.one_apply,
        ite_mul, ite_smul, one_mul, zero_mul, zero_smul, @eq_comm _ b, smul_ite, smul_zero];
      congr' 1, },
    { rintro ⟨i'⟩ - hi',
      rw [ne.def, ulift.up_inj, eq_comm] at hi',
      rw [category.assoc],
      ext;
      rw [category.assoc, category.assoc, comp_zsmul, zsmul_comp, comp_zsmul, comp_zsmul,
        category.comp_id, zero_comp];
      [rw biprod.lift_fst, rw biprod.lift_snd];
      rw [biproduct.lift_π, biproduct.ι_π];
      simp only [dite_eq_ite, equiv.apply_eq_iff_eq, and_true, prod.mk.inj_iff,
        eq_self_iff_true, ulift.up_inj, eq_to_hom_refl, equiv.ulift_symm_apply,
        eq_false_intro hi', and_false, if_false, smul_zero], },
    { intro h, exact (h (finset.mem_univ _)).elim } },
  { intros x y,
    simp only [add_monoid_hom.map_add, functor.map_add, comp_add, add_comp, nat_trans.app_add],
    abel }
end
.

@[simps {fully_applied := ff}]
def aux :
  (data.eval_functor F).obj ((data.mul 2).obj BD'.data) ≅
  Biprod ⋙ (data.eval_functor F).obj BD'.data :=
nat_iso.of_components (λ A,
  homological_complex.hom.iso_of_components (λ i, begin
      refine F.map_iso _,
      refine (Pow_comp_Pow 2 (BD'.data.X i)).symm.app A ≪≫ _,
      refine (Pow _).map_iso (Biprod_iso_Pow_two.symm.app A)
    end) $ λ i j hij, aux' F A (BD'.data.X i) (BD'.data.X j) (BD'.data.d i j)) $ λ A B f, begin
      ext i,
      dsimp only [data.eval_functor, data.eval_functor', eval_Pow, eval_Pow_functor_obj,
        functor.map_iso_hom, functor.comp_obj, functor.comp_map, functor.flip_obj_map,
        iso.trans_hom, iso.symm_hom, nat_iso.app_hom,
        functor.map_homological_complex_obj_X,
        homological_complex.functor_eval_map_app_f,
        homological_complex.comp_f,
        homological_complex.hom.iso_of_components_hom_f],
      rw [← F.map_comp, ← F.map_comp, ← category.assoc, nat_trans.naturality,
        category.assoc, category.assoc, functor.comp_map, ← functor.map_comp, ← functor.map_comp,
        nat_trans.naturality],
  end
.

-- move this up
lemma quux (n : ℕ) {N : ℕ} (k : fin N) (A : 𝒜) :
  (basic_universal_map.proj n k).eval_Pow.app A =
  biproduct.matrix (λ i j, if i.down = fin_prod_fin_equiv (k, j.down) then 𝟙 A else 0) :=
begin
  apply category_theory.limits.biproduct.hom_ext,
  rintro ⟨j⟩,
  apply category_theory.limits.biproduct.hom_ext',
  refine equiv.ulift.forall_congr_left'.mpr _,
  refine fin_prod_fin_equiv.forall_congr_left.mp _,
  rintro ⟨l, i⟩,
  dsimp only [basic_universal_map.eval_Pow_app],
  rw [biproduct.matrix_π, biproduct.matrix_π, biproduct.ι_desc, biproduct.ι_desc],
  dsimp only [basic_universal_map.proj, basic_universal_map.proj_aux,
    matrix.reindex_linear_equiv_apply, matrix.reindex_apply, matrix.minor,
    matrix.kronecker_map],
  simp only [ite_mul, ite_smul, one_mul, one_smul, zero_mul, zero_smul, matrix.one_apply],
  rw [← ite_and],
  congr' 1,
  apply propext,
  rw [← equiv.symm_apply_eq, prod.ext_iff],
  apply and_congr iff.rfl,
  dsimp only [equiv.punit_prod_symm_apply],
  rw [eq_comm],
end
.

-- move this up
lemma eval_Pow_add {m n : ℕ} (f g : basic_universal_map m n) (A : 𝒜) :
  (f + g).eval_Pow.app A = f.eval_Pow.app A + g.eval_Pow.app A :=
begin
  dsimp [basic_universal_map.eval_Pow_app],
  ext ⟨i⟩ ⟨j⟩,
  simp only [biproduct.ι_matrix, biproduct.lift_π, comp_add, add_comp, add_zsmul],
end
.

def eval_functor_homotopy (A : 𝒜) : _root_.homotopy
  (((data.eval_functor F).obj BD'.data).map (biprod.fst + biprod.snd : A ⊞ A ⟶ A))
  (((data.eval_functor F).obj BD'.data).map (biprod.fst : A ⊞ A ⟶ A) +
    ((data.eval_functor F).obj BD'.data).map (biprod.snd : A ⊞ A ⟶ A)) :=
begin
  refine ((eval_homotopy' F BD' A).symm.comp_left ((aux F BD').inv.app A)).congr _ _ _ _,
  { ext i,
    rw [homological_complex.comp_f, aux_inv_app_f,
      functor.map_homological_complex_map_f, functor.comp_map, eval_Pow_functor_map,
      evaluation_obj_map, data.eval_functor_obj_map_f],
    dsimp only [data.sum, universal_map.sum],
    rw [eval_Pow_of, whisker_right_app, ← F.map_comp, fin.sum_univ_two,
      eval_Pow_add, quux, quux],
    congr' 1,
    apply category_theory.limits.biproduct.hom_ext', rintro ⟨m⟩,
    rw [biproduct.ι_desc_assoc, biproduct.ι_map, category.assoc],
    apply category_theory.limits.biproduct.hom_ext, rintro ⟨n⟩,
    rw [category.assoc],
    apply category_theory.limits.biprod.hom_ext';
    [rw [biprod.inl_desc_assoc], rw [biprod.inr_desc_assoc]];
    rw [category.assoc, biproduct.ι_desc_assoc, add_comp, comp_add,
      biproduct.matrix_π, biproduct.matrix_π, biproduct.ι_desc, biproduct.ι_desc,
      category.assoc, add_comp, comp_add];
    simp only [biprod.inl_fst_assoc, biprod.inl_snd_assoc,
      biprod.inr_fst_assoc, biprod.inr_snd_assoc, zero_comp, add_zero, zero_add,
      true_and, equiv.apply_eq_iff_eq, prod.mk.inj_iff, one_ne_zero,
      fin.zero_eq_one_iff, fin.one_eq_zero_iff, eq_self_iff_true, if_false, false_and],
      all_goals
      { by_cases hmn : m = n,
        { cases hmn, rw [if_pos rfl, biproduct.ι_π_self], },
        { rw [if_neg, biproduct.ι_π_ne]; [rw [ne.def, ulift.up_inj], skip]; exact hmn } } },
  { ext i,
    rw [homological_complex.comp_f, aux_inv_app_f,
      functor.map_homological_complex_map_f, functor.comp_map, eval_Pow_functor_map,
      evaluation_obj_map,
      homological_complex.add_f_apply,
      data.eval_functor_obj_map_f, data.eval_functor_obj_map_f],
    dsimp only [data.proj, proj],
    rw [add_monoid_hom.map_sum, fin.sum_univ_two, eval_Pow_of, eval_Pow_of,
      nat_trans.app_add, whisker_right_app, whisker_right_app, comp_add,
      ← F.map_comp, ← F.map_comp, quux, quux],
    congr' 2;
    { apply category_theory.limits.biproduct.hom_ext, rintro ⟨n⟩,
      rw [biproduct.map_π, category.assoc, biproduct.matrix_π],
      apply category_theory.limits.biproduct.hom_ext', rintro ⟨m⟩,
      rw [biproduct.ι_desc_assoc, category.assoc],
      apply category_theory.limits.biprod.hom_ext';
      [rw [biprod.inl_desc_assoc], rw [biprod.inr_desc_assoc]],
      all_goals
      { rw [biproduct.ι_desc_assoc, biproduct.ι_desc];
        simp only [true_and, equiv.apply_eq_iff_eq, prod.mk.inj_iff,
          eq_self_iff_true, ulift.up_inj, ulift.down_inj];
        by_cases hmn : m = n,
        { cases hmn,
          simp only [biproduct.ι_π_self_assoc, eq_self_iff_true, if_true, if_false,
            biprod.inl_fst, biprod.inr_fst, biprod.inl_snd, biprod.inr_snd,
            zero_ne_one, one_ne_zero, false_and, fin.one_eq_zero_iff, fin.zero_eq_one_iff], },
        { rw biproduct.ι_π_ne_assoc, swap, { rw [ne.def, ulift.up_inj], exact hmn },
          simp only [hmn, if_false, and_false, zero_comp, comp_zero] } } } }
end
.

end package

end breen_deligne


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.traversable.equiv
import control.traversable.instances
import data.lazy_list

/-!
## Definitions on lazy lists

This file contains various definitions and proofs on lazy lists.

TODO: move the `lazy_list.lean` file from core to mathlib.
-/

universes u

namespace thunk

/-- Creates a thunk with a (non-lazy) constant value. -/
def mk {α} (x : α) : thunk α := λ _, x

instance {α : Type u} [decidable_eq α] : decidable_eq (thunk α) | a b :=
have a = b ↔ a () = b (), from ⟨by cc, by intro; ext x; cases x; assumption⟩,
by rw this; apply_instance

end thunk

namespace lazy_list

open function

/-- Isomorphism between strict and lazy lists. -/
def list_equiv_lazy_list (α : Type*) : list α ≃ lazy_list α :=
{ to_fun := lazy_list.of_list,
  inv_fun := lazy_list.to_list,
  right_inv := by { intro, induction x, refl, simp! [*],
                    ext, cases x, refl },
  left_inv := by { intro, induction x, refl, simp! [*] } }

instance {α : Type u} [decidable_eq α] : decidable_eq (lazy_list α)
| nil nil := is_true rfl
| (cons x xs) (cons y ys) :=
  if h : x = y then
    match decidable_eq (xs ()) (ys ()) with
    | is_false h2 := is_false (by intro; cc)
    | is_true h2 :=
      have xs = ys, by ext u; cases u; assumption,
      is_true (by cc)
    end
  else
    is_false (by intro; cc)
| nil (cons _ _) := is_false (by cc)
| (cons _ _) nil := is_false (by cc)

/-- Traversal of lazy lists using an applicative effect. -/
protected def traverse {m : Type u → Type u} [applicative m] {α β : Type u}
    (f : α → m β) : lazy_list α → m (lazy_list β)
| lazy_list.nil := pure lazy_list.nil
| (lazy_list.cons x xs) := lazy_list.cons <$> f x <*> (thunk.mk <$> traverse (xs ()))

instance : traversable lazy_list :=
{ map := @lazy_list.traverse id _,
  traverse := @lazy_list.traverse }

instance : is_lawful_traversable lazy_list :=
begin
  apply equiv.is_lawful_traversable' list_equiv_lazy_list;
  intros ; resetI; ext,
  { induction x, refl,
    simp! [equiv.map,functor.map] at *,
    simp [*], refl, },
  { induction x, refl,
    simp! [equiv.map,functor.map_const] at *,
    simp [*], refl, },
  { induction x,
    { simp! [traversable.traverse,equiv.traverse] with functor_norm, refl },
    simp! [equiv.map,functor.map_const,traversable.traverse] at *, rw x_ih,
    dsimp [list_equiv_lazy_list,equiv.traverse,to_list,traversable.traverse,list.traverse],
    simp! with functor_norm, refl },
end

/-- `init xs`, if `xs` non-empty, drops the last element of the list.
Otherwise, return the empty list. -/
def init {α} : lazy_list α → lazy_list α
| lazy_list.nil := lazy_list.nil
| (lazy_list.cons x xs) :=
  let xs' := xs () in
  match xs' with
  | lazy_list.nil := lazy_list.nil
  | (lazy_list.cons _ _) := lazy_list.cons x (init xs')
  end

/-- Return the first object contained in the list that satisfies
predicate `p` -/
def find {α} (p : α → Prop) [decidable_pred p] : lazy_list α → option α
| nil        := none
| (cons h t) := if p h then some h else find (t ())

/-- `interleave xs ys` creates a list where elements of `xs` and `ys` alternate. -/
def interleave {α} : lazy_list α → lazy_list α → lazy_list α
| lazy_list.nil xs := xs
| a@(lazy_list.cons x xs) lazy_list.nil := a
| (lazy_list.cons x xs) (lazy_list.cons y ys) :=
  lazy_list.cons x (lazy_list.cons y (interleave (xs ()) (ys ())))

/-- `interleave_all (xs::ys::zs::xss)` creates a list where elements of `xs`, `ys`
and `zs` and the rest alternate. Every other element of the resulting list is taken from
`xs`, every fourth is taken from `ys`, every eighth is taken from `zs` and so on. -/
def interleave_all {α} : list (lazy_list α) → lazy_list α
| [] := lazy_list.nil
| (x :: xs) := interleave x (interleave_all xs)

/-- Monadic bind operation for `lazy_list`. -/
protected def bind {α β} : lazy_list α → (α → lazy_list β) → lazy_list β
| lazy_list.nil _ := lazy_list.nil
| (lazy_list.cons x xs) f := lazy_list.append (f x) (bind (xs ()) f)

/-- Reverse the order of a `lazy_list`.
It is done by converting to a `list` first because reversal involves evaluating all
the list and if the list is all evaluated, `list` is a better representation for
it than a series of thunks. -/
def reverse {α} (xs : lazy_list α) : lazy_list α :=
of_list xs.to_list.reverse

instance : monad lazy_list :=
{ pure := @lazy_list.singleton,
  bind := @lazy_list.bind }

lemma append_assoc {α} (xs ys zs : lazy_list α) :
  (xs.append ys).append zs = xs.append (ys.append zs) :=
by induction xs; simp [append, *]

lemma append_bind {α β} (xs : lazy_list α) (ys : thunk (lazy_list α)) (f : α → lazy_list β) :
  (@lazy_list.append _ xs ys).bind f = (xs.bind f).append ((ys ()).bind f) :=
by induction xs; simp [lazy_list.bind, append, *, append_assoc, append, lazy_list.bind]

instance : is_lawful_monad lazy_list :=
{ pure_bind := by { intros, apply append_nil },
  bind_assoc := by { intros, dsimp [(>>=)], induction x; simp [lazy_list.bind, append_bind, *], },
  id_map :=
  begin
    intros,
    simp [(<$>)],
    induction x; simp [lazy_list.bind, *, singleton, append],
    ext ⟨ ⟩, refl,
  end }

/-- Try applying function `f` to every element of a `lazy_list` and
return the result of the first attempt that succeeds. -/
def mfirst {m} [alternative m] {α β} (f : α → m β) : lazy_list α → m β
| nil := failure
| (cons x xs) :=
  f x <|> mfirst (xs ())

/-- Membership in lazy lists -/
protected def mem {α} (x : α) : lazy_list α → Prop
| lazy_list.nil := false
| (lazy_list.cons y ys) := x = y ∨ mem (ys ())

instance {α} : has_mem α (lazy_list α) :=
⟨ lazy_list.mem ⟩

instance mem.decidable {α} [decidable_eq α] (x : α) : Π xs : lazy_list α, decidable (x ∈ xs)
| lazy_list.nil := decidable.false
| (lazy_list.cons y ys) :=
  if h : x = y
    then decidable.is_true (or.inl h)
    else decidable_of_decidable_of_iff (mem.decidable (ys ())) (by simp [*, (∈), lazy_list.mem])

@[simp]
lemma mem_nil {α} (x : α) : x ∈ @lazy_list.nil α ↔ false := iff.rfl

@[simp]
lemma mem_cons {α} (x y : α) (ys : thunk (lazy_list α)) :
  x ∈ @lazy_list.cons α y ys ↔ x = y ∨ x ∈ ys () := iff.rfl

theorem forall_mem_cons {α} {p : α → Prop} {a : α} {l : thunk (lazy_list α)} :
  (∀ x ∈ @lazy_list.cons _ a l, p x) ↔ p a ∧ ∀ x ∈ l (), p x :=
by simp only [has_mem.mem, lazy_list.mem, or_imp_distrib, forall_and_distrib, forall_eq]

/-! ### map for partial functions -/

/-- Partial map. If `f : Π a, p a → β` is a partial function defined on
  `a : α` satisfying `p`, then `pmap f l h` is essentially the same as `map f l`
  but is defined only when all members of `l` satisfy `p`, using the proof
  to apply `f`. -/
@[simp] def pmap {α β} {p : α → Prop} (f : Π a, p a → β) :
  Π l : lazy_list α, (∀ a ∈ l, p a) → lazy_list β
| lazy_list.nil         H := lazy_list.nil
| (lazy_list.cons x xs) H := lazy_list.cons (f x (forall_mem_cons.1 H).1)
                               (pmap (xs ()) (forall_mem_cons.1 H).2)

/-- "Attach" the proof that the elements of `l` are in `l` to produce a new `lazy_list`
  with the same elements but in the type `{x // x ∈ l}`. -/
def attach {α} (l : lazy_list α) : lazy_list {x // x ∈ l} := pmap subtype.mk l (λ a, id)

instance {α} [has_repr α] : has_repr (lazy_list α) :=
⟨ λ xs, repr xs.to_list ⟩

end lazy_list


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module control.bitraversable.basic
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Bifunctor
import Mathbin.Control.Traversable.Basic

/-!
# Bitraversable type class

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

Type class for traversing bifunctors.

Simple examples of `bitraversable` are `prod` and `sum`. A more elaborate example is
to define an a-list as:

```
def alist (key val : Type) := list (key × val)
```

Then we can use `f : key → io key'` and `g : val → io val'` to manipulate the `alist`'s key
and value respectively with `bitraverse f g : alist key val → io (alist key' val')`

## Main definitions

* `bitraversable`: Bare typeclass to hold the `bitraverse` function.
* `is_lawful_bitraversable`: Typeclass for the laws of the `bitraverse` function. Similar to
  `is_lawful_traversable`.

## References

The concepts and laws are taken from
<https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Bitraversable.html>

## Tags

traversable bitraversable iterator functor bifunctor applicative
-/

universe u

#print Bitraversable /-
/-- Lawless bitraversable bifunctor. This only holds data for the bimap and bitraverse. -/
class Bitraversable (t : Type u → Type u → Type u) extends Bifunctor t where
  bitraverse :
    ∀ {m : Type u → Type u} [Applicative m] {α α' β β'},
      (α → m α') → (β → m β') → t α β → m (t α' β')
#align bitraversable Bitraversable
-/

export Bitraversable (bitraverse)

#print bisequence /-
/-- A bitraversable functor commutes with all applicative functors. -/
def bisequence {t m} [Bitraversable t] [Applicative m] {α β} : t (m α) (m β) → m (t α β) :=
  bitraverse id id
#align bisequence bisequence
-/

open Functor

#print IsLawfulBitraversable /-
/-- Bifunctor. This typeclass asserts that a lawless bitraversable bifunctor is lawful. -/
class IsLawfulBitraversable (t : Type u → Type u → Type u) [Bitraversable t] extends
  LawfulBifunctor t where
  id_bitraverse : ∀ {α β} (x : t α β), bitraverse id.mk id.mk x = id.mk x
  comp_bitraverse :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G]
      {α α' β β' γ γ'} (f : β → F γ) (f' : β' → F γ') (g : α → G β) (g' : α' → G β') (x : t α α'),
      bitraverse (Comp.mk ∘ map f ∘ g) (Comp.mk ∘ map f' ∘ g') x =
        Comp.mk (bitraverse f f' <$> bitraverse g g' x)
  bitraverse_eq_bimap_id :
    ∀ {α α' β β'} (f : α → β) (f' : α' → β') (x : t α α'),
      bitraverse (id.mk ∘ f) (id.mk ∘ f') x = id.mk (bimap f f' x)
  binaturality :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G]
      (η : ApplicativeTransformation F G) {α α' β β'} (f : α → F β) (f' : α' → F β') (x : t α α'),
      η (bitraverse f f' x) = bitraverse (@η _ ∘ f) (@η _ ∘ f') x
#align is_lawful_bitraversable IsLawfulBitraversable
-/

export IsLawfulBitraversable (id_bitraverse comp_bitraverse bitraverse_eq_bimap_id)

open IsLawfulBitraversable

attribute [higher_order.1bitraverse_id_id] id_bitraverse

attribute [higher_order.1bitraverse_comp] comp_bitraverse

attribute [higher_order.1] binaturality bitraverse_eq_bimap_id

export IsLawfulBitraversable (bitraverse_id_id bitraverse_comp)


/-
Copyright (c) 2021 Luke Kershaw. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luke Kershaw
-/
import category_theory.preadditive.additive_functor
import category_theory.shift
import category_theory.triangulated.rotate

/-!
# Pretriangulated Categories

This file contains the definition of pretriangulated categories and triangulated functors
between them.

## Implementation Notes

We work under the assumption that pretriangulated categories are preadditive categories,
but not necessarily additive categories, as is assumed in some sources.

TODO: generalise this to n-angulated categories as in https://arxiv.org/abs/1006.4592
-/

noncomputable theory

open category_theory
open category_theory.preadditive
open category_theory.limits

universes v v₀ v₁ v₂ u u₀ u₁ u₂

namespace category_theory.triangulated
open category_theory.category

/-
We work in a preadditive category `C` equipped with an additive shift.
-/
variables (C : Type u) [category.{v} C] [has_zero_object C] [has_shift C ℤ] [preadditive C]
  [∀ n : ℤ, functor.additive (shift_functor C n)]

/--
A preadditive category `C` with an additive shift, and a class of "distinguished triangles"
relative to that shift is called pretriangulated if the following hold:
* Any triangle that is isomorphic to a distinguished triangle is also distinguished.
* Any triangle of the form `(X,X,0,id,0,0)` is distinguished.
* For any morphism `f : X ⟶ Y` there exists a distinguished triangle of the form `(X,Y,Z,f,g,h)`.
* The triangle `(X,Y,Z,f,g,h)` is distinguished if and only if `(Y,Z,X⟦1⟧,g,h,-f⟦1⟧)` is.
* Given a diagram:
  ```
        f       g       h
    X  ───> Y  ───> Z  ───> X⟦1⟧
    │       │                │
    │a      │b               │a⟦1⟧'
    V       V                V
    X' ───> Y' ───> Z' ───> X'⟦1⟧
        f'      g'      h'
  ```
  where the left square commutes, and whose rows are distinguished triangles,
  there exists a morphism `c : Z ⟶ Z'` such that `(a,b,c)` is a triangle morphism.

See https://stacks.math.columbia.edu/tag/0145
-/
class pretriangulated :=
(distinguished_triangles [] : set (triangle C))
(isomorphic_distinguished : Π (T₁ ∈ distinguished_triangles) (T₂ ≅ T₁),
  T₂ ∈ distinguished_triangles)
(contractible_distinguished : Π (X : C), (contractible_triangle C X) ∈ distinguished_triangles)
(distinguished_cocone_triangle : Π (X Y : C) (f : X ⟶ Y), (∃ (Z : C) (g : Y ⟶ Z)
  (h : Z ⟶ X⟦(1:ℤ)⟧),
  triangle.mk _ f g h ∈ distinguished_triangles))
(rotate_distinguished_triangle : Π (T : triangle C),
  T ∈ distinguished_triangles ↔ T.rotate ∈ distinguished_triangles)
(complete_distinguished_triangle_morphism : Π (T₁ T₂ : triangle C)
  (h₁ : T₁ ∈ distinguished_triangles) (h₂ : T₂ ∈ distinguished_triangles) (a : T₁.obj₁ ⟶ T₂.obj₁)
  (b : T₁.obj₂ ⟶ T₂.obj₂) (comm₁ : T₁.mor₁ ≫ b = a ≫ T₂.mor₁),
  (∃ (c : T₁.obj₃ ⟶ T₂.obj₃), (T₁.mor₂ ≫ c = b ≫ T₂.mor₂) ∧ (T₁.mor₃ ≫ a⟦1⟧' = c ≫ T₂.mor₃) ))

namespace pretriangulated
variables [pretriangulated C]

notation `dist_triang`:20 C := distinguished_triangles C
/--
Given any distinguished triangle `T`, then we know `T.rotate` is also distinguished.
-/
lemma rot_of_dist_triangle (T ∈ dist_triang C) : (T.rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle T).mp H

/--
Given any distinguished triangle `T`, then we know `T.inv_rotate` is also distinguished.
-/
lemma inv_rot_of_dist_triangle (T ∈ dist_triang C) : (T.inv_rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle (T.inv_rotate)).mpr
  (isomorphic_distinguished T H T.inv_rotate.rotate (inv_rot_comp_rot.app T))

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `f ≫ g = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₁₂ (T ∈ dist_triang C) : T.mor₁ ≫ T.mor₂ = 0 :=
begin
  have h := contractible_distinguished T.obj₁,
  have f := complete_distinguished_triangle_morphism,
  specialize f (contractible_triangle C T.obj₁) T h H (𝟙 T.obj₁) T.mor₁,
  have t : (contractible_triangle C T.obj₁).mor₁ ≫ T.mor₁ = 𝟙 T.obj₁ ≫ T.mor₁,
    by refl,
  specialize f t,
  cases f with c f,
  rw ← f.left,
  simp only [limits.zero_comp, contractible_triangle_mor₂],
end -- TODO : tidy this proof up

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `g ≫ h = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₂₃  (T ∈ dist_triang C) : T.mor₂ ≫ T.mor₃ = 0 :=
comp_dist_triangle_mor_zero₁₂ C T.rotate (rot_of_dist_triangle C T H)

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `h ≫ f⟦1⟧ = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₃₁ (T ∈ dist_triang C) :
  T.mor₃ ≫ ((shift_equiv C 1).functor.map T.mor₁) = 0 :=
have H₂ : _ := rot_of_dist_triangle C T.rotate (rot_of_dist_triangle C T H),
by simpa using comp_dist_triangle_mor_zero₁₂ C (T.rotate.rotate) H₂

/-
TODO: If `C` is pretriangulated with respect to a shift,
then `Cᵒᵖ` is pretriangulated with respect to the inverse shift.
-/
end pretriangulated
end category_theory.triangulated

namespace category_theory.triangulated
namespace pretriangulated

variables (C : Type u₁) [category.{v₁} C] [has_zero_object C] [has_shift C ℤ] [preadditive C]
  [∀ n : ℤ, functor.additive (shift_functor C n)]
variables (D : Type u₂) [category.{v₂} D] [has_zero_object D] [has_shift D ℤ] [preadditive D]
  [∀ n : ℤ, functor.additive (shift_functor D n)]

/--
The underlying structure of a triangulated functor between pretriangulated categories `C` and `D`
is a functor `F : C ⥤ D` together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧`.
-/
structure triangulated_functor_struct extends (C ⥤ D) :=
(comm_shift : shift_functor C (1 : ℤ) ⋙ to_functor ≅ to_functor ⋙ shift_functor D (1 : ℤ))

instance : inhabited (triangulated_functor_struct C C) :=
⟨{ obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl }⟩

variables {C D}
/--
Given a `triangulated_functor_struct` we can define a function from triangles of `C` to
triangles of `D`.
-/
@[simp]
def triangulated_functor_struct.map_triangle (F : triangulated_functor_struct C D)
  (T : triangle C) : triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

variables (C D)
/--
A triangulated functor between pretriangulated categories `C` and `D` is a functor `F : C ⥤ D`
together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧` such that for every
distinguished triangle `(X,Y,Z,f,g,h)` of `C`, the triangle
`(F(X), F(Y), F(Z), F(f), F(g), F(h) ≫ (ξ X))` is a distinguished triangle of `D`.
See https://stacks.math.columbia.edu/tag/014V
-/
structure triangulated_functor [pretriangulated C] [pretriangulated D] extends
  triangulated_functor_struct C D :=
(map_distinguished' : Π (T: triangle C), (T ∈ dist_triang C) →
  (to_triangulated_functor_struct.map_triangle T ∈ dist_triang D) )

instance [pretriangulated C] : inhabited (triangulated_functor C C) :=
⟨{obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl ,
  map_distinguished' := begin
    rintros ⟨_,_,_,_⟩ Tdt,
    dsimp at *,
    rwa category.comp_id,
  end }⟩

variables {C D} [pretriangulated C] [pretriangulated D]
/--
Given a `triangulated_functor` we can define a function from triangles of `C` to triangles of `D`.
-/
@[simp]
def triangulated_functor.map_triangle (F : triangulated_functor C D) (T : triangle C) :
  triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

/--
Given a `triangulated_functor` and a distinguished triangle `T` of `C`, then the triangle it
maps onto in `D` is also distinguished.
-/
lemma triangulated_functor.map_distinguished (F : triangulated_functor C D) (T : triangle C)
  (h : T ∈ dist_triang C) : (F.map_triangle T) ∈ dist_triang D := F.map_distinguished' T h

end pretriangulated
end category_theory.triangulated


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.generator
import category_theory.limits.cone_category
import category_theory.limits.constructions.weakly_initial
import category_theory.limits.functor_category
import category_theory.subobject.comma

/-!
# Adjoint functor theorem

This file proves the (general) adjoint functor theorem, in the form:
* If `G : D ⥤ C` preserves limits and `D` has limits, and satisfies the solution set condition,
  then it has a left adjoint: `is_right_adjoint_of_preserves_limits_of_solution_set_condition`.

We show that the converse holds, i.e. that if `G` has a left adjoint then it satisfies the solution
set condition, see `solution_set_condition_of_is_right_adjoint`
(the file `category_theory/adjunction/limits` already shows it preserves limits).

We define the *solution set condition* for the functor `G : D ⥤ C` to mean, for every object
`A : C`, there is a set-indexed family ${f_i : A ⟶ G (B_i)}$ such that any morphism `A ⟶ G X`
factors through one of the `f_i`.

This file also proves the special adjoint functor theorem, in the form:
* If `G : D ⥤ C` preserves limits and `D` is complete, well-powered and has a small coseparating
  set, then `G` has a left adjoint: `is_right_adjoint_of_preserves_limits_of_is_coseparating`

Finally, we prove the following corollary of the special adjoint functor theorem:
* If `C` is complete, well-powered and has a small coseparating set, then it is cocomplete:
  `has_colimits_of_has_limits_of_is_coseparating`

-/
universes v u u'

namespace category_theory
open limits

variables {J : Type v}
variables {C : Type u} [category.{v} C]

/--
The functor `G : D ⥤ C` satisfies the *solution set condition* if for every `A : C`, there is a
family of morphisms `{f_i : A ⟶ G (B_i) // i ∈ ι}` such that given any morphism `h : A ⟶ G X`,
there is some `i ∈ ι` such that `h` factors through `f_i`.

The key part of this definition is that the indexing set `ι` lives in `Type v`, where `v` is the
universe of morphisms of the category: this is the "smallness" condition which allows the general
adjoint functor theorem to go through.
-/
def solution_set_condition {D : Type u} [category.{v} D] (G : D ⥤ C) : Prop :=
∀ (A : C), ∃ (ι : Type v) (B : ι → D) (f : Π (i : ι), A ⟶ G.obj (B i)),
  ∀ X (h : A ⟶ G.obj X), ∃ (i : ι) (g : B i ⟶ X), f i ≫ G.map g = h

section general_adjoint_functor_theorem
variables {D : Type u} [category.{v} D]

variables (G : D ⥤ C)

/-- If `G : D ⥤ C` is a right adjoint it satisfies the solution set condition.  -/
lemma solution_set_condition_of_is_right_adjoint [is_right_adjoint G] :
  solution_set_condition G :=
begin
  intros A,
  refine ⟨punit, λ _, (left_adjoint G).obj A, λ _, (adjunction.of_right_adjoint G).unit.app A, _⟩,
  intros B h,
  refine ⟨punit.star, ((adjunction.of_right_adjoint G).hom_equiv _ _).symm h, _⟩,
  rw [←adjunction.hom_equiv_unit, equiv.apply_symm_apply],
end

/--
The general adjoint functor theorem says that if `G : D ⥤ C` preserves limits and `D` has them,
if `G` satisfies the solution set condition then `G` is a right adjoint.
-/
noncomputable def is_right_adjoint_of_preserves_limits_of_solution_set_condition
  [has_limits D] [preserves_limits G] (hG : solution_set_condition G) :
  is_right_adjoint G :=
begin
  apply is_right_adjoint_of_structured_arrow_initials _,
  intro A,
  specialize hG A,
  choose ι B f g using hG,
  let B' : ι → structured_arrow A G := λ i, structured_arrow.mk (f i),
  have hB' : ∀ (A' : structured_arrow A G), ∃ i, nonempty (B' i ⟶ A'),
  { intros A',
    obtain ⟨i, _, t⟩ := g _ A'.hom,
    exact ⟨i, ⟨structured_arrow.hom_mk _ t⟩⟩ },
  obtain ⟨T, hT⟩ := has_weakly_initial_of_weakly_initial_set_and_has_products hB',
  apply has_initial_of_weakly_initial_and_has_wide_equalizers hT,
end

end general_adjoint_functor_theorem

section special_adjoint_functor_theorem
variables {D : Type u'} [category.{v} D]

/--
The special adjoint functor theorem: if `G : D ⥤ C` preserves limits and `D` is complete,
well-powered and has a small coseparating set, then `G` has a left adjoint.
-/
noncomputable def is_right_adjoint_of_preserves_limits_of_is_coseparating [has_limits D]
  [well_powered D] {𝒢 : set D} [small.{v} 𝒢] (h𝒢 : is_coseparating 𝒢) (G : D ⥤ C)
  [preserves_limits G] : is_right_adjoint G :=
have ∀ A, has_initial (structured_arrow A G),
  from λ A, has_initial_of_is_coseparating (structured_arrow.is_coseparating_proj_preimage A G h𝒢),
by exactI is_right_adjoint_of_structured_arrow_initials _

/--
The special adjoint functor theorem: if `F : C ⥤ D` preserves colimits and `C` is cocomplete,
well-copowered and has a small separating set, then `F` has a right adjoint.
-/
noncomputable def is_left_adjoint_of_preserves_colimits_of_is_separatig [has_colimits C]
  [well_powered Cᵒᵖ] {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_separating 𝒢) (F : C ⥤ D)
  [preserves_colimits F] : is_left_adjoint F :=
have ∀ A, has_terminal (costructured_arrow F A),
  from λ A, has_terminal_of_is_separating (costructured_arrow.is_separating_proj_preimage F A h𝒢),
by exactI is_left_adjoint_of_costructured_arrow_terminals _

end special_adjoint_functor_theorem

namespace limits

/-- A consequence of the special adjoint functor theorem: if `C` is complete, well-powered and
    has a small coseparating set, then it is cocomplete. -/
lemma has_colimits_of_has_limits_of_is_coseparating [has_limits C] [well_powered C]
  {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_coseparating 𝒢) : has_colimits C :=
{ has_colimits_of_shape := λ J hJ, by exactI has_colimits_of_shape_iff_is_right_adjoint_const.2
    ⟨is_right_adjoint_of_preserves_limits_of_is_coseparating h𝒢 _⟩ }

/-- A consequence of the special adjoint functor theorem: if `C` is cocomplete, well-copowered and
    has a small separating set, then it is complete. -/
lemma has_limits_of_has_colimits_of_is_separating [has_colimits C] [well_powered Cᵒᵖ]
  {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_separating 𝒢) : has_limits C :=
{ has_limits_of_shape := λ J hJ, by exactI has_limits_of_shape_iff_is_left_adjoint_const.2
    ⟨is_left_adjoint_of_preserves_colimits_of_is_separatig h𝒢 _⟩ }

end limits

end category_theory


-- See: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/OO.20polymorphism.3F/near/297629381
namespace O41

inductive Geo_Type
| Point2D
| Point3D
| Point4D
| Square2D
deriving Repr, DecidableEq

open Geo_Type

structure Slots_Point2D where
  (x y : Float)
  deriving Repr

structure Slots_Point3D extends Slots_Point2D where
  z : Float
  deriving Repr

structure Slots_Point4D extends Slots_Point3D where
  w : Float
  deriving Repr

structure Slots_Square2D extends Slots_Point2D where
  width : Float
  deriving Repr

def Geo_Type.Slots : Geo_Type → Type
| Point2D => Slots_Point2D
| Point3D => Slots_Point3D
| Point4D => Slots_Point4D
| Square2D => Slots_Square2D

/-- Even though Geo_Type.Slots returns a Type,
 - the following proves that there is a Repr instance for that Type.
 -/
def toRepr : (T : Geo_Type) → Repr T.Slots :=
by {
  intro T;
  cases T <;>
  unfold Geo_Type.Slots <;>
  simp <;>
  infer_instance
}

/-- Get casting funct
ion to first type from second type -/
def Geo_Type.cast : (t : Geo_Type) → (t' : Geo_Type) → Option (t'.Slots → t.Slots)
| Point2D, Point2D => some id
| Point2D, Point3D => some (λ x => x.toSlots_Point2D)
| Point3D, Point3D => some id
| Point2D, Point4D => some (λ x => x.toSlots_Point2D)
| Point3D, Point4D => some (λ x => x.toSlots_Point3D)
| Point4D, Point4D => some id
| Point2D, Square2D => some (λ x => x.toSlots_Point2D)
| Square2D, Square2D => some id
| _, _ => none

/-- Whether the second type is a subtype of the first. -/
def Geo_Type.supertype (t t' : Geo_Type) : Bool := (t.cast t').isSome

theorem Geo_Type.supertype.trans (h : Geo_Type.supertype t t') (h' : Geo_Type.supertype t' t'') :
  Geo_Type.supertype t t'' :=
by
  cases t
  all_goals
    cases t'
    all_goals
      cases t''
      all_goals
        simp at h
        try simp at h'
        try simp

def Option.get : (x : Option α) → x.isSome → α
| some v, _ => v
| none, h => by simp [Option.isSome] at h

/-- Get the cast function from a proof that `t'` is a subtype of `t`. -/
def Geo_Type.supertype.cast (h : Geo_Type.supertype t t') : t'.Slots → t.Slots :=
  Option.get (Geo_Type.cast t t') h

/-- Objects of subtype t -/
structure Obj (t : Geo_Type) where
  ty : Geo_Type
  sub : Geo_Type.supertype t ty
  slots : ty.Slots

instance : Coe Slots_Point2D (Obj Point2D) where coe s := ⟨Point2D, rfl, s⟩
instance : Coe Slots_Point3D (Obj Point3D) where coe s := ⟨Point3D, rfl, s⟩
instance : Coe Slots_Point4D (Obj Point4D) where coe s := ⟨Point4D, rfl, s⟩
instance : Coe Slots_Square2D (Obj Square2D) where coe s := ⟨Square2D, rfl, s⟩

/-- Extract the slots from an `Obj`. -/
def Obj.get (o : Obj t) : t.Slots := Geo_Type.supertype.cast o.sub o.slots

/-- Cast up, which can be done statically. -/
def Obj.cast_up (o : Obj t) (h : Geo_Type.supertype t' t := by rfl) : Obj t' where
  ty := o.ty
  sub := Geo_Type.supertype.trans h o.sub
  slots := o.slots

def Obj.can_cast (o : Obj t) (t' : Geo_Type) : Bool := Geo_Type.supertype t' o.ty

/-- Cast up or down using run-time information. -/
def Obj.cast (o : Obj t) (h : o.can_cast t') : Obj t' where
  ty := o.ty
  sub := h
  slots := o.slots

instance : Repr (Obj (T : Geo_Type)) where
  reprPrec o _ := ((instReprGeo_Type.reprPrec o.ty 1).append (Std.Format.text " ")).append ((toRepr o.ty).reprPrec o.slots 1)

def s2: Slots_Point2D := {x := 1, y := 2}
#eval s2

def o2: Obj Point2D := s2
#eval o2

def o3: Obj Point3D := ({x := 1, y := 2, z := 3}: Slots_Point3D)
#eval o3
#eval o3.get
#eval o3.slots
#eval o3.slots.x
#eval o3.slots.y
#eval o3.slots.z

def o4: Obj Point4D := ({x := 1, y := 2, z := 3, w := 4}: Slots_Point4D)
#eval o4
#eval o4.get.w
-- 4.000000

def o43: Obj Point3D := o4.cast_up
#eval o43
#eval o43.slots.w
-- 4.000000
#eval o43.get
--#eval o43.get.w
-- invalid field 'w', the environment does not contain 'O41.Geo_Type.Slots.w'
--  Obj.get o43
-- has type
--  Slots Point3D
end O41


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem two_colorable_iff_bipartite (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  split,
  {
    assume h1 : two_colorable G,
    have h2 : ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ E G), from sorry,
    show bipartite G, from sorry,
  },
  {
    assume h1 : bipartite G,
    have h2 : ∃ A B : set G, (∀ a : G, a ∈ A ∨ a ∈ B) ∧ (∀ a b : G, a ∈ A ∧ b ∈ B → (a,b) ∈ E G), from sorry,
    show two_colorable G, from sorry,
  }
end

--OUTPUT 2
theorem bipartite_graph_two_colorable (G : Type*) [graph G] :
  (∃ A B : set G, is_bipartite G A B) ↔ (∃ f : G → bool, is_valid_coloring G f) :=
begin
  have h1 : (∃ A B : set G, is_bipartite G A B) → (∃ f : G → bool, is_valid_coloring G f), from sorry,
  have h2 : (∃ f : G → bool, is_valid_coloring G f) → (∃ A B : set G, is_bipartite G A B), from sorry,
  show (∃ A B : set G, is_bipartite G A B) ↔ (∃ f : G → bool, is_valid_coloring G f), from sorry,
end

--OUTPUT 3
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : (∃ A B : set G, is_bipartite G A B) ↔ (∃ f : G → ℕ, is_two_coloring G f) :=
begin
  split,
  {
    assume h1 : ∃ A B : set G, is_bipartite G A B,
    cases h1 with A h1,
    cases h1 with B h1,
    cases h1 with h1 h2,
    have h3 : ∀ a : G, a ∈ A ∨ a ∈ B, from sorry,
    have h4 : ∀ a b : G, a ∈ A ∧ b ∈ B → edge G a b, from sorry,
    have h5 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h6 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h7 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G b a, from sorry,
    have h8 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G b a, from sorry,
    have h9 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h10 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h11 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h12 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h13 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h14 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h15 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h16 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h17 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h18 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h19 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h20 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h21 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h22 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h23 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h24 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h25 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h26 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h27 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h28 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h29 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h30 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h31 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h32 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h33 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h34 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h35 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h36 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h37 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h38 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h39 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h40 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h41 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h42 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h43 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h44 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h45 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h46 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h47 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h48 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h49 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h50 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h51 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h52 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h53 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h54 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h55 : ∀ a b : G, a ∈ A ∧ b ∈ B → ¬ edge G a b, from sorry,
    have h56 : ∀ a b : G, a ∈ B ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h57 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge G a b, from sorry,
    have h58 : ∀ a b : G, a
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


inductive Foo (f: Fin n): Nat → Prop
| mk: Foo f f.val
theorem foo {f: Fin n}: Foo f (no_index f.val) := .mk
example (hf: f < n): Foo ⟨f, hf⟩ f := by simp only [foo]
example  (f: Fin n): Foo  f f.val  := by simp only [foo]


import o_minimal.sheaf.yoneda

-- Lemmas for proving definability of propositions with quantifiers
-- `∀ (x : X), P x`, `∃ (x : X), P x`. Here `X` must be representable.

namespace o_minimal

variables {R : Type*} {S : struc R}
variables {X : Type*} [has_coordinates R X] [definable_rep S X]

lemma definable_forall : definable S (λ (p : X → Prop), ∀ x, p x) :=
begin
  rw definable_fun,
  intros K φ hφ,
  rw ←definable_yoneda at ⊢ hφ,
  rw definable_iff_def_set,
  rw definable_iff_def_rel₂ at hφ,
  apply def_set.forall hφ,
end

-- Helper lemma for applying `definable_forall` in a `[defin]` block.
lemma definable_sheaf.forall {Γ : Def S}
  (p : Γ → X → Prop) {hp : definable_sheaf.definable p} :
  definable_sheaf.definable (λ i, ∀ x, p i x) :=
begin
  apply definable_sheaf.definable_app (λ i (p : X → Prop), ∀ x, p x),
  { exact hp },
  { exact definable_forall.definable _ }
end

-- Not directly related to quantifiers,
-- but frequently appears in "bounded" ones.
lemma definable_sheaf.imp {Γ : Def S}
  (p : Γ → Prop) {hp : definable_sheaf.definable p}
  (q : Γ → Prop) {hq : definable_sheaf.definable q} :
  definable_sheaf.definable (λ i, p i → q i) :=
def_set.imp hp hq

-- `definable S Exists`
lemma definable_Exists : definable S (λ (p : X → Prop), ∃ x, p x) :=
begin
  rw definable_fun,
  intros K φ hφ,
  rw ←definable_yoneda at ⊢ hφ,
  rw definable_iff_def_set,
  rw definable_iff_def_rel₂ at hφ,
  apply def_set.exists hφ,
end

lemma definable_nonempty : definable S (set.nonempty : set X → Prop) :=
begin [defin]
  intro s,
  app, exact definable_Exists.definable _,
  intro x,
  app, app, exact definable.mem.definable _, var, var
end

lemma definable_sheaf.eq {Γ : Def S} :
  definable_sheaf.definable (λ _ : Γ, @eq X) :=
begin
  intros K φ hφ L ψ hψ,
  rw ← definable_yoneda at hφ hψ ⊢,
  rw definable_iff_def_set,
  apply def_set_eq;
  rw ← definable_iff_def_fun,
  begin [defin]
    intro x,
    app, exact definable.snd.definable _,
    app, exact hφ.definable _,
    app, exact definable.fst.definable _,
    app, exact hψ.definable _,
    var,
  end,
  begin [defin]
    intro x,
    app, exact definable.snd.definable _,
    app, exact hψ.definable _,
    var,
  end
end

end o_minimal

namespace defin.interactive
setup_tactic_parser

meta def all (var : parse ident_) : defin unit :=
do `[refine o_minimal.definable_sheaf.forall _],
   intro var

meta def imp : defin unit :=
`[refine o_minimal.definable_sheaf.imp _ _]

end defin.interactive

namespace o_minimal

variables {R : Type*} {S : struc R}
variables {X : Type*} [has_coordinates R X] [definable_rep S X]

lemma definable_subset : definable S ((⊆) : set X → set X → Prop) :=
begin [defin]
  intro s,
  intro t,
  all x,
  imp,
  { app, app, exact definable.mem.definable _, var, var },
  { app, app, exact definable.mem.definable _, var, var }
end

lemma definable_powerset : definable S (set.powerset : set X → set (set X)) :=
begin [defin]
  intro s,
  intro t,
  app, app, exact definable_subset.definable _, var, var
end

end o_minimal


/-
Copyright (c) 2020 Zhangir Azerbayev. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Eric Wieser, Zhangir Azerbayev
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.multilinear
import Mathlib.linear_algebra.linear_independent
import Mathlib.group_theory.perm.sign
import Mathlib.PostPort

universes u_1 u_2 u_3 u_6 l u_4 u_5 u_7

namespace Mathlib

/-!
# Alternating Maps

We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
arguments of the same type.

## Main definitions
* `alternating_map R M N ι` is the space of `R`-linear alternating maps from `ι → M` to `N`.
* `f.map_eq_zero_of_eq` expresses that `f` is zero when two inputs are equal.
* `f.map_swap` expresses that `f` is negated when two inputs are swapped.
* `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
* An `add_comm_monoid`, `add_comm_group`, and `semimodule` structure over `alternating_map`s that
  matches the definitions over `multilinear_map`s.
* `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.

## Implementation notes
`alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
using `map_swap` as a definition, and does not require `has_neg N`.

`alternating_map`s are provided with a coercion to `multilinear_map`, along with a set of
`norm_cast` lemmas that act on the algebraic structure:

* `alternating_map.coe_add`
* `alternating_map.coe_zero`
* `alternating_map.coe_sub`
* `alternating_map.coe_neg`
* `alternating_map.coe_smul`
-/

-- semiring / add_comm_monoid

-- semiring / add_comm_group

/--
An alternating map is a multilinear map that vanishes when two of its arguments are equal.
-/
structure alternating_map (R : Type u_1) [semiring R] (M : Type u_2) [add_comm_monoid M] [semimodule R M] (N : Type u_3) [add_comm_monoid N] [semimodule R N] (ι : Type u_6) [DecidableEq ι]
extends multilinear_map R (fun (i : ι) => M) N
where
  map_eq_zero_of_eq' : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → to_fun v = 0

/-- The multilinear map associated to an alternating map -/
namespace alternating_map

/-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/

protected instance has_coe_to_fun {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : has_coe_to_fun (alternating_map R M N ι) :=
  has_coe_to_fun.mk (fun (x : alternating_map R M N ι) => ((i : ι) → (fun (i : ι) => M) i) → N)
    fun (x : alternating_map R M N ι) => to_fun x

@[simp] theorem to_fun_eq_coe {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) : to_fun f = ⇑f :=
  rfl

@[simp] theorem coe_mk {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : (ι → M) → N) (h₁ : ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (x y : M),
  f (function.update m i (x + y)) = f (function.update m i x) + f (function.update m i y)) (h₂ : ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (c : R) (x : M),
  f (function.update m i (c • x)) = c • f (function.update m i x)) (h₃ : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → f v = 0) : ⇑(mk f h₁ h₂ h₃) = f :=
  rfl

theorem congr_fun {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {f : alternating_map R M N ι} {g : alternating_map R M N ι} (h : f = g) (x : ι → M) : coe_fn f x = coe_fn g x :=
  congr_arg (fun (h : alternating_map R M N ι) => coe_fn h x) h

theorem congr_arg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) {x : ι → M} {y : ι → M} (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (fun (x : ι → M) => coe_fn f x) h

theorem coe_inj {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {f : alternating_map R M N ι} {g : alternating_map R M N ι} (h : ⇑f = ⇑g) : f = g := sorry

theorem ext {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {f : alternating_map R M N ι} {f' : alternating_map R M N ι} (H : ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn f' x) : f = f' :=
  coe_inj (funext H)

theorem ext_iff {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {f : alternating_map R M N ι} {g : alternating_map R M N ι} : f = g ↔ ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : (i : ι) → (fun (i : ι) => M) i) => h ▸ rfl,
    mpr := fun (h : ∀ (x : (i : ι) → (fun (i : ι) => M) i), coe_fn f x = coe_fn g x) => ext h }

protected instance multilinear_map.has_coe {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : has_coe (alternating_map R M N ι) (multilinear_map R (fun (i : ι) => M) N) :=
  has_coe.mk fun (x : alternating_map R M N ι) => to_multilinear_map x

@[simp] theorem coe_multilinear_map {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) : ⇑↑f = ⇑f :=
  rfl

@[simp] theorem to_multilinear_map_eq_coe {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) : to_multilinear_map f = ↑f :=
  rfl

@[simp] theorem coe_multilinear_map_mk {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : (ι → M) → N) (h₁ : ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (x y : M),
  f (function.update m i (x + y)) = f (function.update m i x) + f (function.update m i y)) (h₂ : ∀ (m : (i : ι) → (fun (i : ι) => M) i) (i : ι) (c : R) (x : M),
  f (function.update m i (c • x)) = c • f (function.update m i x)) (h₃ : ∀ (v : ι → M) (i j : ι), v i = v j → i ≠ j → f v = 0) : ↑(mk f h₁ h₂ h₃) = multilinear_map.mk f h₁ h₂ :=
  rfl

/-!
### Simp-normal forms of the structure fields

These are expressed in terms of `⇑f` instead of `f.to_fun`.
-/

@[simp] theorem map_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) (i : ι) (x : M) (y : M) : coe_fn f (function.update v i (x + y)) = coe_fn f (function.update v i x) + coe_fn f (function.update v i y) :=
  multilinear_map.map_add' (to_multilinear_map f) v i x y

@[simp] theorem map_sub {R : Type u_1} [semiring R] {M' : Type u_4} [add_comm_group M'] [semimodule R M'] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g' : alternating_map R M' N' ι) (v' : ι → M') (i : ι) (x : M') (y : M') : coe_fn g' (function.update v' i (x - y)) = coe_fn g' (function.update v' i x) - coe_fn g' (function.update v' i y) :=
  multilinear_map.map_sub (to_multilinear_map g') v' i x y

@[simp] theorem map_neg {R : Type u_1} [semiring R] {M' : Type u_4} [add_comm_group M'] [semimodule R M'] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g' : alternating_map R M' N' ι) (v' : ι → M') (i : ι) (x : M') : coe_fn g' (function.update v' i (-x)) = -coe_fn g' (function.update v' i x) :=
  multilinear_map.map_neg (to_multilinear_map g') v' i x

@[simp] theorem map_smul {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) (i : ι) (r : R) (x : M) : coe_fn f (function.update v i (r • x)) = r • coe_fn f (function.update v i x) :=
  multilinear_map.map_smul' (to_multilinear_map f) v i r x

@[simp] theorem map_eq_zero_of_eq {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (h : v i = v j) (hij : i ≠ j) : coe_fn f v = 0 :=
  map_eq_zero_of_eq' f v i j h hij

/-!
### Algebraic structure inherited from `multilinear_map`

`alternating_map` carries the same `add_comm_monoid`, `add_comm_group`, and `semimodule` structure
as `multilinear_map`
-/

protected instance has_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : Add (alternating_map R M N ι) :=
  { add := fun (a b : alternating_map R M N ι) => mk (multilinear_map.to_fun (↑a + ↑b)) sorry sorry sorry }

@[simp] theorem add_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (f' : alternating_map R M N ι) (v : ι → M) : coe_fn (f + f') v = coe_fn f v + coe_fn f' v :=
  rfl

theorem coe_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (f' : alternating_map R M N ι) : ↑(f + f') = ↑f + ↑f' :=
  rfl

protected instance has_zero {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : HasZero (alternating_map R M N ι) :=
  { zero := mk (multilinear_map.to_fun 0) sorry sorry sorry }

@[simp] theorem zero_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (v : ι → M) : coe_fn 0 v = 0 :=
  rfl

theorem coe_zero {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : ↑0 = 0 :=
  rfl

protected instance inhabited {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : Inhabited (alternating_map R M N ι) :=
  { default := 0 }

protected instance add_comm_monoid {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] : add_comm_monoid (alternating_map R M N ι) :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance has_neg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] : Neg (alternating_map R M N' ι) :=
  { neg := fun (f : alternating_map R M N' ι) => mk (multilinear_map.to_fun (-↑f)) sorry sorry sorry }

@[simp] theorem neg_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) (m : ι → M) : coe_fn (-g) m = -coe_fn g m :=
  rfl

theorem coe_neg {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) : ↑(-g) = -↑g :=
  rfl

protected instance has_sub {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] : Sub (alternating_map R M N' ι) :=
  { sub := fun (f g : alternating_map R M N' ι) => mk (multilinear_map.to_fun (↑f - ↑g)) sorry sorry sorry }

@[simp] theorem sub_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) (g₂ : alternating_map R M N' ι) (m : ι → M) : coe_fn (g - g₂) m = coe_fn g m - coe_fn g₂ m :=
  rfl

theorem coe_sub {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) (g₂ : alternating_map R M N' ι) : ↑(g - g₂) = ↑g - ↑g₂ :=
  rfl

protected instance add_comm_group {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] : add_comm_group (alternating_map R M N' ι) :=
  add_comm_group.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry

protected instance has_scalar {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] : has_scalar S (alternating_map R M N ι) :=
  has_scalar.mk fun (c : S) (f : alternating_map R M N ι) => mk (multilinear_map.to_fun (c • ↑f)) sorry sorry sorry

@[simp] theorem smul_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] (c : S) (m : ι → M) : coe_fn (c • f) m = c • coe_fn f m :=
  rfl

theorem coe_smul {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] (c : S) : ↑(c • f) = c • ↑f :=
  rfl

protected instance distrib_mul_action {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {S : Type u_7} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] : distrib_mul_action S (alternating_map R M N ι) :=
  distrib_mul_action.mk sorry sorry

/-- The space of multilinear maps over an algebra over `R` is a module over `R`, for the pointwise
addition and scalar multiplication. -/
protected instance semimodule {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {S : Type u_7} [semiring S] [semimodule S N] [smul_comm_class R S N] : semimodule S (alternating_map R M N ι) :=
  semimodule.mk sorry sorry

end alternating_map

/-!
### Composition with linear maps
-/

namespace linear_map

/-- Composing a alternating map with a linear map gives again a alternating map. -/
def comp_alternating_map {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂] (g : linear_map R N N₂) : alternating_map R M N ι →+ alternating_map R M N₂ ι :=
  add_monoid_hom.mk
    (fun (f : alternating_map R M N ι) =>
      alternating_map.mk (multilinear_map.to_fun (comp_multilinear_map g ↑f)) sorry sorry sorry)
    sorry sorry

@[simp] theorem coe_comp_alternating_map {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂] (g : linear_map R N N₂) (f : alternating_map R M N ι) : ⇑(coe_fn (comp_alternating_map g) f) = ⇑g ∘ ⇑f :=
  rfl

theorem comp_alternating_map_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] {N₂ : Type u_7} [add_comm_monoid N₂] [semimodule R N₂] (g : linear_map R N N₂) (f : alternating_map R M N ι) (m : ι → M) : coe_fn (coe_fn (comp_alternating_map g) f) m = coe_fn g (coe_fn f m) :=
  rfl

end linear_map

namespace alternating_map

/-!
### Other lemmas from `multilinear_map`
-/

theorem map_update_sum {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) {α : Type u_4} (t : finset α) (i : ι) (g : α → M) (m : ι → M) : coe_fn f (function.update m i (finset.sum t fun (a : α) => g a)) =
  finset.sum t fun (a : α) => coe_fn f (function.update m i (g a)) :=
  multilinear_map.map_update_sum (to_multilinear_map f) t i g m

/-!
### Theorems specific to alternating maps

Various properties of reordered and repeated inputs which follow from
`alternating_map.map_eq_zero_of_eq`.
-/

theorem map_update_self {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) : coe_fn f (function.update v i (v j)) = 0 := sorry

theorem map_update_update {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) (m : M) : coe_fn f (function.update (function.update v i m) j m) = 0 := sorry

theorem map_swap_add {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) : coe_fn f (v ∘ ⇑(equiv.swap i j)) + coe_fn f v = 0 := sorry

theorem map_add_swap {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N : Type u_3} [add_comm_monoid N] [semimodule R N] {ι : Type u_6} [DecidableEq ι] (f : alternating_map R M N ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) : coe_fn f v + coe_fn f (v ∘ ⇑(equiv.swap i j)) = 0 := sorry

theorem map_swap {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) (v : ι → M) {i : ι} {j : ι} (hij : i ≠ j) : coe_fn g (v ∘ ⇑(equiv.swap i j)) = -coe_fn g v :=
  eq_neg_of_add_eq_zero (map_swap_add g v hij)

theorem map_perm {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) [fintype ι] (v : ι → M) (σ : equiv.perm ι) : coe_fn g (v ∘ ⇑σ) = ↑(coe_fn equiv.perm.sign σ) • coe_fn g v := sorry

theorem map_congr_perm {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) (v : ι → M) [fintype ι] (σ : equiv.perm ι) : coe_fn g v = ↑(coe_fn equiv.perm.sign σ) • coe_fn g (v ∘ ⇑σ) := sorry

theorem coe_dom_dom_congr {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] (g : alternating_map R M N' ι) [fintype ι] (σ : equiv.perm ι) : multilinear_map.dom_dom_congr σ ↑g = ↑(coe_fn equiv.perm.sign σ) • ↑g :=
  multilinear_map.ext fun (v : ι → M) => map_perm g v σ

/-- If the arguments are linearly dependent then the result is `0`.

TODO: Can the `division_ring` requirement be relaxed? -/
theorem map_linear_dependent {ι : Type u_6} [DecidableEq ι] {K : Type u_1} [division_ring K] {M : Type u_2} [add_comm_group M] [semimodule K M] {N : Type u_3} [add_comm_group N] [semimodule K N] (f : alternating_map K M N ι) (v : ι → M) (h : ¬linear_independent K v) : coe_fn f v = 0 := sorry

end alternating_map

namespace multilinear_map

/-- Produce an `alternating_map` out of a `multilinear_map`, by summing over all argument
permutations. -/
def alternatization {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] [fintype ι] : multilinear_map R (fun (i : ι) => M) N' →+ alternating_map R M N' ι :=
  add_monoid_hom.mk
    (fun (m : multilinear_map R (fun (i : ι) => M) N') =>
      alternating_map.mk
        ⇑(finset.sum finset.univ fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • dom_dom_congr σ m) sorry sorry
        sorry)
    sorry sorry

theorem alternatization_def {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] [fintype ι] (m : multilinear_map R (fun (i : ι) => M) N') : ⇑(coe_fn alternatization m) =
  ⇑(finset.sum finset.univ fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • dom_dom_congr σ m) :=
  rfl

theorem alternatization_apply {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] [fintype ι] (m : multilinear_map R (fun (i : ι) => M) N') (v : ι → M) : coe_fn (coe_fn alternatization m) v =
  finset.sum finset.univ fun (σ : equiv.perm ι) => ↑(coe_fn equiv.perm.sign σ) • coe_fn (dom_dom_congr σ m) v := sorry

end multilinear_map

namespace alternating_map

/-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
where `n` is the number of inputs. -/
theorem coe_alternatization {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] [fintype ι] (a : alternating_map R M N' ι) : coe_fn multilinear_map.alternatization ↑a = nat.factorial (fintype.card ι) • a := sorry

end alternating_map

namespace linear_map

/-- Composition with a linear map before and after alternatization are equivalent. -/
theorem comp_multilinear_map_alternatization {R : Type u_1} [semiring R] {M : Type u_2} [add_comm_monoid M] [semimodule R M] {N' : Type u_5} [add_comm_group N'] [semimodule R N'] {ι : Type u_6} [DecidableEq ι] {N'₂ : Type u_7} [add_comm_group N'₂] [semimodule R N'₂] [fintype ι] (g : linear_map R N' N'₂) (f : multilinear_map R (fun (_x : ι) => M) N') : coe_fn multilinear_map.alternatization (comp_multilinear_map g f) =
  coe_fn (comp_alternating_map g) (coe_fn multilinear_map.alternatization f) := sorry