import Lbar.functor
import combinatorial_lemma.finite
import algebra.module.linear_map
import pseudo_normed_group.bounded_limits
import for_mathlib.Profinite.disjoint_union

import category_theory.limits.shapes.products
import topology.category.Compactum

noncomputable theory

open_locale nnreal big_operators

universe u

section
variables (r : ℝ≥0) [fact (0 < r)] (Λ : Type u) [polyhedral_lattice Λ]

open category_theory
open category_theory.limits

lemma polyhedral_exhaustive
  (M : Type*) [pseudo_normed_group M]
  (e : ∀ x : M, ∃ c, x ∈ pseudo_normed_group.filtration M c)
  (x : Λ →+ M) :
  ∃ c : ℝ≥0, x ∈ pseudo_normed_group.filtration (Λ →+ M) c :=
begin
  obtain ⟨ι,hι,l,hl,h⟩ := polyhedral_lattice.polyhedral Λ,
  resetI,
  let cs : ι → ℝ≥0 := λ i, (e (x (l i))).some,
  let c := finset.univ.sup (λ i, cs i / ∥l i∥₊),
  -- This should be easy, using the fact that (l i) ≠ 0.
  have hc : ∀ i, cs i ≤ c * ∥l i∥₊,
  { intro i, rw ← mul_inv_le_iff₀,
    { exact finset.le_sup (finset.mem_univ i), },
    { rw [ne.def, nnnorm_eq_zero], exact h i }, },
  use c,
  rw generates_norm.add_monoid_hom_mem_filtration_iff hl x,
  intros i,
  apply pseudo_normed_group.filtration_mono (hc i),
  apply (e (x (l i))).some_spec,
end

@[simps]
def polyhedral_postcompose {M N : ProFiltPseuNormGrpWithTinv₁ r} (f : M ⟶ N) :
  comphaus_filtered_pseudo_normed_group_with_Tinv_hom r
  (Λ →+ M) (Λ →+ N) :=
{ to_fun := λ x, f.to_add_monoid_hom.comp x,
  map_zero' := by simp only [add_monoid_hom.comp_zero],
  map_add' := by { intros, ext, dsimp, erw [f.to_add_monoid_hom.map_add], refl, },
  strict' := begin
      obtain ⟨ι,hι,l,hl,h⟩ := polyhedral_lattice.polyhedral Λ,
      resetI,
      intros c x hx,
      erw generates_norm.add_monoid_hom_mem_filtration_iff hl at hx ⊢,
      intros i,
      apply f.strict,
      exact hx i,
    end,
  continuous' := λ c, begin
    rw polyhedral_lattice.add_monoid_hom.continuous_iff,
    intro l,
    simp only,
    have aux1 := polyhedral_lattice.add_monoid_hom.incl_continuous Λ r M c,
    have aux2 := f.level_continuous (c * ∥l∥₊),
    exact (aux2.comp (continuous_apply l)).comp aux1,
  end,
  map_Tinv' := λ x, by { ext l, dsimp, erw f.map_Tinv, refl, } }

/-- the functor `M ↦ Hom(Λ, M), where both are considered as objects in
  `ProFiltPseuNormGrpWithTinv₁.{u} r` -/
@[simps]
def hom_functor : ProFiltPseuNormGrpWithTinv₁.{u} r ⥤ ProFiltPseuNormGrpWithTinv₁.{u} r :=
{ obj := λ M,
  { M := Λ →+ M,
    str := infer_instance,
    exhaustive' := by { apply polyhedral_exhaustive, apply M.exhaustive r } },
  map := λ M N f, polyhedral_postcompose _ _ f,
  map_id' := λ M, begin
    ext,
    dsimp [polyhedral_postcompose],
    simp,
  end,
  map_comp' := λ M N L f g, begin
    ext,
    dsimp [polyhedral_postcompose],
    simp,
  end } .

@[simps]
def polyhedral_postcompose' {M N : PseuNormGrp₁} (f : M ⟶ N) :
  strict_pseudo_normed_group_hom (Λ →+ M) (Λ →+ N) :=
{ to_fun := λ x, f.to_add_monoid_hom.comp x,
  map_zero' := by simp only [add_monoid_hom.comp_zero],
  map_add' := by { intros, ext, dsimp, erw [f.to_add_monoid_hom.map_add], refl, },
  strict' := begin
      obtain ⟨ι,hι,l,hl,h⟩ := polyhedral_lattice.polyhedral Λ,
      resetI,
      intros c x hx,
      erw generates_norm.add_monoid_hom_mem_filtration_iff hl at hx ⊢,
      intros i,
      apply f.strict,
      exact hx i,
    end }

@[simps]
def hom_functor' : PseuNormGrp₁.{u} ⥤ PseuNormGrp₁.{u} :=
{ obj := λ M,
  { carrier := Λ →+ M ,
    exhaustive' := by { apply polyhedral_exhaustive, apply M.exhaustive } },
  map := λ M N f, polyhedral_postcompose' _ f,
  map_id' := λ X, by { ext, refl },
  map_comp' := λ X Y Z f g, by { ext, refl } }

open category_theory.limits PseuNormGrp₁

variables {J : Type u} [small_category J] (K : J ⥤ PseuNormGrp₁.{u})

def Ab.limit_cone' {J : Type u} [small_category J] (K : J ⥤ Ab.{u}) :
  limit_cone K :=
⟨Ab.explicit_limit_cone.{u u} _, Ab.explicit_limit_cone_is_limit.{u u} _⟩

attribute [simps] to_Ab Ab.limit_cone'

abbreviation hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux_val_aux (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁)
  (f : ↥(bounded_cone_point
            (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ to_Ab))))
  (q : Λ) :
  ↥((Ab.limit_cone' (K ⋙ to_Ab)).cone.X) :=
{ val := λ j, (f.1.1 j).1 q,
  property := begin
    intros a b g,
    have := f.1.2 g,
    dsimp at this ⊢,
    rw ← this, refl,
  end }

abbreviation hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁)
  (f : ↥(bounded_cone_point
            (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ to_Ab)))) :
  Λ → ↥(bounded_cone_point (Ab.limit_cone' (K ⋙ to_Ab))) := λ q,
{ val := hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux_val_aux Λ _ f q,
  property := begin
    obtain ⟨c,hc⟩ := f.2,
    use c * ∥q∥₊,
    intros j,
    apply hc,
    simp,
  end }

abbreviation hom_functor'_cone_iso_hom_to_fun_aux
  (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁) :
  ↥(bounded_cone_point
       (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ to_Ab))) →
  ↥((hom_functor' Λ).obj
       (bounded_cone_point (Ab.limit_cone' (K ⋙ to_Ab)))) := λ f,
{ to_fun := hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux _ _ f,
  map_zero' := by { ext, simpa },
  map_add' := λ x y, by { ext, simpa } }

def hom_functor'_cone_iso_hom :
  bounded_cone_point (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ _)) ⟶
  (hom_functor' Λ).obj (bounded_cone_point (Ab.limit_cone' (K ⋙ _))) :=
{ to_fun := hom_functor'_cone_iso_hom_to_fun_aux _ _,
  map_zero' := by { ext, simpa },
  map_add' := λ x y, by { ext, simpa },
  strict' := begin
    intros c x hx,
    obtain ⟨⟨d,hc⟩,rfl⟩ := hx,
    intros e q hq,
    dsimp [bounded_elements.filt_incl],
    delta hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux,
    delta hom_functor'_cone_iso_hom_to_fun_aux_to_fun_aux_val_aux,
    refine ⟨⟨_,_⟩,rfl⟩,
    intros j,
    apply hc _ hq,
  end }

abbreviation hom_functor'_cone_iso_inv_to_fun_aux_val_aux_val_aux
  (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁)
  (f : ↥((hom_functor' Λ).obj
            (bounded_cone_point (Ab.limit_cone' (K ⋙ to_Ab))))) :
  Π (j : J), (((K ⋙ hom_functor' Λ) ⋙ to_Ab) ⋙ forget Ab).obj j := λ j,
{ to_fun := λ q, (f.1 q).1.1 j,
  map_zero' := by simpa,
  map_add' := λ x y, by simpa }

abbreviation hom_functor'_cone_iso_inv_to_fun_aux_val_aux
  (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁)
  (f : ↥((hom_functor' Λ).obj
            (bounded_cone_point (Ab.limit_cone' (K ⋙ to_Ab))))) :
  ↥((Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ to_Ab)).cone.X) :=
{ val := hom_functor'_cone_iso_inv_to_fun_aux_val_aux_val_aux _ _ f,
  property := begin
    intros i j g,
    ext q,
    change Λ →+ _ at f,
    exact (f q).1.2 g,
  end }

abbreviation hom_functor'_cone_iso_inv_to_fun_aux (Λ : Type u) {J : Type u}
  [polyhedral_lattice Λ]
  [small_category J]
  (K : J ⥤ PseuNormGrp₁) :
  ↥((hom_functor' Λ).obj
       (bounded_cone_point (Ab.limit_cone' (K ⋙ to_Ab)))) →
  ↥(bounded_cone_point
       (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ to_Ab))) := λ f,
{ val := hom_functor'_cone_iso_inv_to_fun_aux_val_aux _ _ f,
  property := begin
    obtain ⟨c,hc⟩ :=
      ((hom_functor' Λ).obj (bounded_cone_point
      (Ab.limit_cone' (K ⋙ to_Ab)))).exhaustive f,
    use c,
    intros j d q hq,
    dsimp [Ab.explicit_limit_cone],
    specialize hc hq,
    obtain ⟨t,ht⟩ := hc,
    rw ← ht,
    apply t.2,
  end }

def hom_functor'_cone_iso_inv :
  (hom_functor' Λ).obj (bounded_cone_point (Ab.limit_cone' (K ⋙ _))) ⟶
  bounded_cone_point (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ _)) :=
{ to_fun := hom_functor'_cone_iso_inv_to_fun_aux _ _,
  map_zero' := by { ext, simpa },
  map_add' := λ x y, by { ext, simpa },
  strict' := begin
    intros c x hx,
    dsimp,
    refine ⟨⟨_,_⟩,rfl⟩,
    intros j d q hq,
    dsimp [Ab.explicit_limit_cone],
    specialize hx hq,
    obtain ⟨t,ht⟩ := hx,
    rw ← ht,
    apply t.2,
  end }

def hom_functor'_cone_iso_aux :
  bounded_cone_point (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ _)) ≅
  (hom_functor' Λ).obj (bounded_cone_point (Ab.limit_cone' (K ⋙ _))) :=
{ hom := hom_functor'_cone_iso_hom _ _,
  inv := hom_functor'_cone_iso_inv _ _,
  hom_inv_id' := by { ext, refl },
  inv_hom_id' := by { ext, refl } }

def hom_functor_cone_iso :
  bounded_cone (Ab.limit_cone' ((K ⋙ hom_functor' Λ) ⋙ _)) ≅
  (hom_functor' Λ).map_cone (bounded_cone (Ab.limit_cone' (K ⋙ _))) :=
cones.ext
(hom_functor'_cone_iso_aux _ _) $ λ j, by { ext, refl }

instance : preserves_limits (hom_functor' Λ) :=
begin
  constructor, introsI J hJ, constructor, intros K,
  apply preserves_limit_of_preserves_limit_cone
    (PseuNormGrp₁.bounded_cone_is_limit ⟨_, Ab.explicit_limit_cone_is_limit.{u u} _⟩),
  refine is_limit.of_iso_limit (PseuNormGrp₁.bounded_cone_is_limit
    ⟨_,Ab.explicit_limit_cone_is_limit.{u u} _⟩) _,
  apply hom_functor_cone_iso,
end

instance (c) : preserves_limits (hom_functor'.{u} Λ ⋙ PseuNormGrp₁.level.obj c) :=
@limits.comp_preserves_limits _ _ _ _ _ _ _ _ _ $
show preserves_limits _, from PseuNormGrp₁.preserves_limits_level_obj.{u u} _

def ProFiltPseuNormGrpWithTinv₁.to_PNG₁ :
  ProFiltPseuNormGrpWithTinv₁ r ⥤ PseuNormGrp₁ :=
{ obj := λ M,
  { carrier := M,
    exhaustive' := M.exhaustive r },
  map := λ X Y f, { strict' := λ c x h, f.strict h .. f.to_add_monoid_hom } }

def drop_Profinite_drop_Tinv :
  PFPNGT₁_to_PFPNG₁ₑₗ r ⋙ ProFiltPseuNormGrp₁.to_PNG₁ ≅
  ProFiltPseuNormGrpWithTinv₁.to_PNG₁ r :=
nat_iso.of_components (λ X, iso.refl _) $ by tidy

instance : preserves_limits (ProFiltPseuNormGrpWithTinv₁.to_PNG₁ r) :=
preserves_limits_of_nat_iso (drop_Profinite_drop_Tinv r)

def hom_functor'_forget_iso (c) :
  ProFiltPseuNormGrpWithTinv₁.to_PNG₁ r ⋙ hom_functor' Λ ⋙
  PseuNormGrp₁.level.obj c ≅
  hom_functor _ Λ ⋙ PFPNGT₁_to_PFPNG₁ₑₗ r ⋙
    ProFiltPseuNormGrp₁.level.obj c ⋙ forget _ :=
nat_iso.of_components (λ X, eq_to_iso rfl) $ by tidy

instance hom_functor_level_preserves_limits (c) : preserves_limits (
  hom_functor r Λ ⋙
  PFPNGT₁_to_PFPNG₁ₑₗ r ⋙
  ProFiltPseuNormGrp₁.level.obj c ) :=
begin
  apply preserves_limits_of_reflects_of_preserves _ (forget Profinite),
  apply preserves_limits_of_nat_iso (hom_functor'_forget_iso _ _ _),
  change preserves_limits (ProFiltPseuNormGrpWithTinv₁.to_PNG₁ r ⋙
    (hom_functor' Λ ⋙ PseuNormGrp₁.level.obj c)),
  apply limits.comp_preserves_limits,
end

end


import NBG.SetTheory.Axioms.Basic

open Classical

-- subset function
theorem SubsetInductiveClassOppositeExists:
  ∃T: Class, ∀u:Class,
    (u ∈ T ↔ ∃x y z: Class, ∃_: Set x, ∃_: Set y, ∃_: Set z,
      ∃_: z ∈ x, ∃_: z ∉ y,
        u ＝ ＜x, y, z＞) := by {
  let t := (↺ (E ✕ U)) ∩ (↻ ((U₂ ＼ (RelInv E)) ✕ U));
  have t_def := IntersectionClass_def (↺ (E ✕ U)) (↻ ((U₂ ＼ (RelInv E)) ✕ U));
  have tl_def1 := LeftCycleClass_def (E ✕ U);
  have tl_def2 := ProductClass_def E U;
  have tr_def1 := RightCycleClass_def ((U₂ ＼ (RelInv E)) ✕ U);
  have tr_def2 := ProductClass_def (U₂ ＼ (RelInv E)) U;
  have tr_def3 := Diff_def U₂ (RelInv E);
  have tr_def4 := RelInv_def E;
  have u2_def := ProductClass_def U U;
  have E_def := E_def;
  exists t;
  intro u;
  rw [t_def];
  apply Iff.intro;
  {
    intro h;
    have ⟨z,x,y,set_z,set_x,set_y,hin,heq⟩ := (tl_def1 u).1 h.1;
    exists x,y,z,set_x,set_y,set_z;
    have z_in_x: z ∈ x := by {
      have ⟨e,y',e_in_E,hy',heq'⟩ := (tl_def2 ＜z,x,y＞).1 hin;
      have _ := Set.mk₁ e_in_E;
      have _ := Set.mk₁ hy';
      have ⟨z'',x'',set_z'', set_x'',z_in_x'',heq''⟩ := ((E_def e).1 e_in_E);
      have _ := OrdPair_is_Set z x;
      have zz_xx := OrdPairEq.1 (ClassEq.trans (OrdPairEq.1 heq').1 heq'');
      have := (((AxiomExtensionality x x'').1 zz_xx.2) z'').2 z_in_x'';
      exact ClassEqMenberImpMenber ⟨ClassEq.symm zz_xx.1,this⟩;
    }
    have ⟨y',z',x',set_y',set_z',set_x',hin',heq'⟩ := (tr_def1 u).1 h.2;
    have z_not_in_y: z ∉ y := by {
      intro z_in_y;
      have ⟨e,x1,he,x1_in_U,yzx_eq_ex1⟩ := (tr_def2 ＜y',z',x'＞).1 hin';
      have he2 := (tr_def3 e).1 he;
      have ⟨y1,z1,hy1,hz1,e_eq_y1z1⟩ := (u2_def e).1 he2.1;
      have set_z1 := Set.mk₁ hz1;
      have set_y1 := Set.mk₁ hy1;
      have hn_z1y1 :=  ImpIffNotImpNot.1 (
        NotExistsImpForall (
          NotExistsImpForall (
            NotExistsImpForall (
              NotExistsImpForall (
                NotExistsImpForall (
        (IffIffNotIffNot.1 (tr_def4 e)).2 he2.2) z1) y1) set_z1) set_y1)) (IffNotNot.1 e_eq_y1z1);
      have zy_eq_z1y1 : ＜z,y＞ ＝ ＜z1,y1＞ := by {
        have heq_xyz:= OrdTripleEq.1 (ClassEq.trans (ClassEq.symm heq) heq');
        have _ := Set.mk₁ he;
        have _ := OrdPair_is_Set y' z';
        have _ := Set.mk₂ x1_in_U;
        have heq_yy_zz := OrdPairEq.1 (ClassEq.trans (OrdPairEq.1 yzx_eq_ex1).1 e_eq_y1z1);
        have z_eq_z1:= ClassEq.trans heq_xyz.2.2 heq_yy_zz.2;
        have y_eq_y1:= ClassEq.trans heq_xyz.2.1 heq_yy_zz.1;
        exact OrdPairEq.2 ⟨z_eq_z1,y_eq_y1⟩;
      };
      have h_z1y1 := (E_def ＜z1,y1＞).2 ⟨z,y,set_z,set_y,z_in_y,ClassEq.symm zy_eq_z1y1⟩;
      contradiction;
    }
    exists z_in_x,z_not_in_y;
  }
  {
    intro ⟨x,y,z,set_x,set_y,set_z,z_in_x,z_not_in_y,u_eq_xyz⟩;
    apply And.intro;
    {
      apply (tl_def1 u).2;
      have zx_in_E := (E_def ＜z,x＞).2 ⟨z,x,set_z,set_x,z_in_x,ClassEq.refl _⟩
      have hzxy := (tl_def2 ＜z,x,y＞).2 ⟨＜z,x＞,y,zx_in_E,set_y.2,ClassEq.refl _⟩;
      exists z,x,y,set_z,set_x,set_y,hzxy;
    }
    {
      apply (tr_def1 u).2;
      exists y,z,x,set_y,set_z,set_x;
      have yz_in_u2 := (u2_def ＜y,z＞).2 ⟨y,z,set_y.2,set_z.2,ClassEq.refl _⟩;
      have yz_not_in_relinv_u2: ¬ (＜y,z＞ ∈ RelInv E) := by {
        intro h;
        have ⟨z1,y1,set_z1,set_y1,z1y1_in_E,yz_eqy1z1⟩:= (tr_def4 ＜y,z＞).1 h;
        have ⟨z2,y2,set_z2,set_y2,z2_in_y2,heq_zz_yy⟩:= (E_def ＜z1,y1＞).1 z1y1_in_E;
        have yy_zz1 := OrdPairEq.1 yz_eqy1z1;
        have zz_yy2 := OrdPairEq.1 heq_zz_yy;
        have := ((AxiomExtensionality y y2).1 (ClassEq.trans yy_zz1.1 zz_yy2.2) z).2 (
          ClassEqMenberImpMenber ⟨ClassEq.symm (ClassEq.trans yy_zz1.2 zz_yy2.1),z2_in_y2⟩);
        contradiction;
      }
      have h_yz_in := (tr_def3 ＜y,z＞).2 ⟨yz_in_u2,yz_not_in_relinv_u2⟩;
      exists (tr_def2 ＜y,z,x＞).2 ⟨＜y,z＞,x,h_yz_in,set_x.2,ClassEq.refl _⟩;
    }
  }
}

private noncomputable def T : Class :=
  choose SubsetInductiveClassOppositeExists
private noncomputable def T_def :=
  choose_spec SubsetInductiveClassOppositeExists

theorem SubsetInductiveClassExists:
  ∃S: Class, ∀z:Class,
    (z ∈ S ↔ ∃x y: Class, ∃hx: Set x, ∃hy: Set y,
      ∃_: x ⊂ y,
        z ＝ ＜x, y＞) := by {
  let s := U₂ ＼ (Dom T);
  have s_def := Diff_def U₂ (Dom T);
  have dom_def := Dom_def T;
  have t_def := T_def;
  have u2_def := ProductClass_def U U;

  exists s;
  intro u;
  rw [s_def];
  apply Iff.intro;
  {
    intro h;
    have ⟨x,y,hx,hy,hu⟩ := (u2_def u).1 h.1;
    have set_x := (Set.mk₂ hx);
    have set_y := (Set.mk₂ hy);
    have _:= (OrdPair_is_Set x y);
    have set_u: Set u := Set.mk₁ h.1;
    have : x ⊂ y := by {
      have ht := ExistsIffNotForall.1 ((IffIffNotIffNot.1 ((dom_def u) set_u)).2 h.2);
      clear s_def u2_def dom_def;
      intro v hv;
      by_cases hz': (∃z: Class, z ∈ x ∧ z ∉ y);
      {
        let z := choose hz';
        have hz: z ∈ x ∧ z ∉ y := choose_spec hz';
        have set_z := Set.mk₁ hz.1
        have ht1 := ht z;
        have uz_eq_xyz: ＜u,z＞ ＝ ＜x,y,z＞ := OrdPairEq.2 ⟨hu , ClassEq.refl z⟩;
        have ez_in_T: ∃_:Set z, ＜u,z＞ ∈ T :=
          ⟨set_z, (t_def ＜u,z＞).2 ⟨x,y,z,set_x,set_y,set_z,hz.1,hz.2,uz_eq_xyz⟩⟩;
        clear t_def;
        contradiction;
      }
      {
        cases NotAndIffNotOrNot.1 ((ExistsIffNotForall.1 hz') v);
        case inr.inl hvy => {contradiction;}
        case inr.inr hvy => {exact (IffNotNot.2 hvy);}
      }
    }
    exists x,y,set_x,set_y,this;
  }
  {
    intro ⟨x,y,set_x,set_y,x_subset_y,hu⟩;
    apply And.intro;
    {exact (u2_def u).2 ⟨x,y,set_x.2,set_y.2,hu⟩;}
    {
      intro hn;
      have set_u: Set u := Set.mk₁ hn;
      have ⟨z,set_z,uz_in_T⟩:= (dom_def u set_u).1 hn;
      have ⟨x',y',z',set_x',set_y',set_z',z_in_x',z_not_in_y',heq'⟩ :=
        (t_def ＜u,z＞).1 uz_in_T;
      have set_xy' := (OrdPair_is_Set x' y')
      have heq'' :=
        (@OrdPairEq u z ＜x',y'＞ z' set_u set_z set_xy' set_z').1 heq';
      have heq''' :=
        OrdPairEq.1 (ClassEq.trans (ClassEq.symm hu) heq''.1);
      have :=
        (((AxiomExtensionality y y').1 heq'''.2) z').1 ((x_subset_y z') ((((AxiomExtensionality x x').1 heq'''.1) z').2 z_in_x'));
      contradiction;
    }
  }
}

noncomputable def S : Class :=
  choose SubsetInductiveClassExists
noncomputable def S_def:
  ∀z:Class,
    (z ∈ S ↔ ∃x y: Class, ∃_: Set x, ∃_: Set y,
      ∃_: x ⊂ y,
        z ＝ ＜x, y＞) :=
  choose_spec SubsetInductiveClassExists

theorem SubsetPairAreInS {x y: Class} [hx: Set x] [hy: Set y]:
  x ⊂ y → ＜x, y＞ ∈ S :=
  fun h => (S_def ＜x,y＞).2 ⟨x, y, hx, hy, h, ClassEq.refl _⟩

-- identity function
theorem IdentityFunctionExists:
  ∃Id: Class, ∀z:Class,
    (z ∈ Id ↔ ∃x: Class, ∃_: Set x, z ＝ ＜x, x＞) := by {
  let id := S ∩ (RelInv S);
  have id_def := IntersectionClass_def S (RelInv S);
  have relinv_def := RelInv_def S;
  have s_def := S_def;

  exists id;
  intro z;
  rw [id_def, relinv_def, s_def];
  apply Iff.intro;
  {
    intro ⟨⟨x,y,set_x,set_y,hxy,hz1⟩,⟨x',y',set_x',set_y',hxy',hz2⟩⟩;
    have ⟨x'',y'',set_x'',set_y'',hxy'',hz3⟩ := (s_def ＜x',y'＞).1 hxy';
    have heq := OrdPairEq.1 (ClassEq.trans (ClassEq.symm hz1) hz2);
    have heq' := OrdPairEq.1 hz3;
    have hyx : y ⊂ x := by {
      intro z;
      have hx1 := ((AxiomExtensionality x y').1 heq.1 z).2;
      have hx2:= ((AxiomExtensionality y' y'').1 heq'.2 z).2;
      have hy1 := ((AxiomExtensionality y x').1 heq.2 z).1;
      have hy2:= ((AxiomExtensionality x' x'').1 heq'.1 z).1;
      have := (hxy'' z);
      exact fun h => hx1 (hx2 ((hxy'' z) (hy2 (hy1 h))));
    };
    clear id_def relinv_def s_def id hxy' hxy'' hz2 hz3 heq heq';
    exists x, set_x;
    have := ClassSubsetSymmImplyEq hyx hxy;
    have := (@OrdPairEq x y x x set_x set_y set_x set_x).2 ⟨ClassEq.refl _, this⟩;
    exact ClassEq.trans hz1 this;
  }
  {
    intro ⟨x,hx,hz⟩;
    have hxxS := (s_def ＜x,x＞).2 ⟨x,x,hx,hx,ClassSubset.refl _,ClassEq.refl _⟩;
    exact ⟨⟨x,x,hx,hx,ClassSubset.refl _, hz⟩,⟨x,x,hx,hx,hxxS,hz⟩⟩;
  }
}

noncomputable def IdClass : Class :=
  choose IdentityFunctionExists
noncomputable def IdClass_def:
  ∀z:Class,
    (z ∈ IdClass ↔ ∃x: Class, ∃_: Set x, z ＝ ＜x, x＞) :=
  choose_spec IdentityFunctionExists

theorem AllIdSetIsInId (x: Class) [hx: Set x]:
  ＜x, x＞ ∈ IdClass :=
(IdClass_def ＜x, x＞).2 ⟨x, ⟨hx, ClassEq.refl _⟩⟩

theorem IdClassIsRelation:
  isRelation IdClass := sorry


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.finset.option
import data.pfun

/-!
# Image of a `finset α` under a partially defined function

In this file we define `part.to_finset` and `finset.pimage`. We also prove some trivial lemmas about
these definitions.

## Tags

finite set, image, partial function
-/

variables {α β : Type*}

namespace part

/-- Convert a `o : part α` with decidable `part.dom o` to `finset α`. -/
def to_finset (o : part α) [decidable o.dom] : finset α := o.to_option.to_finset

@[simp] lemma mem_to_finset {o : part α} [decidable o.dom] {x : α} :
  x ∈ o.to_finset ↔ x ∈ o :=
by simp [to_finset]

@[simp] theorem to_finset_none [decidable (none : part α).dom] :
  none.to_finset = (∅ : finset α) :=
by simp [to_finset]

@[simp] theorem to_finset_some {a : α} [decidable (some a).dom] :
  (some a).to_finset = {a} :=
by simp [to_finset]

@[simp] lemma coe_to_finset (o : part α) [decidable o.dom] :
  (o.to_finset : set α) = {x | x ∈ o} :=
set.ext $ λ x, mem_to_finset

end part

namespace finset

variables [decidable_eq β] {f g : α →. β} [∀ x, decidable (f x).dom]
  [∀ x, decidable (g x).dom] {s t : finset α} {b : β}

/-- Image of `s : finset α` under a partially defined function `f : α →. β`. -/
def pimage (f : α →. β) [∀ x, decidable (f x).dom] (s : finset α) : finset β :=
s.bUnion (λ x, (f x).to_finset)

@[simp] lemma mem_pimage : b ∈ s.pimage f ↔ ∃ (a ∈ s), b ∈ f a := by simp [pimage]

@[simp, norm_cast] lemma coe_pimage : (s.pimage f : set β) = f.image s :=
set.ext $ λ x, mem_pimage

@[simp] lemma pimage_some (s : finset α) (f : α → β) [∀ x, decidable (part.some $ f x).dom] :
  s.pimage (λ x, part.some (f x)) = s.image f :=
by { ext, simp [eq_comm] }

lemma pimage_congr (h₁ : s = t) (h₂ : ∀ x ∈ t, f x = g x) : s.pimage f = t.pimage g :=
by { subst s, ext y, simp [h₂] { contextual := tt } }

/-- Rewrite `s.pimage f` in terms of `finset.filter`, `finset.attach`, and `finset.image`. -/
lemma pimage_eq_image_filter : s.pimage f =
  (filter (λ x, (f x).dom) s).attach.image (λ x, (f x).get (mem_filter.1 x.coe_prop).2) :=
by { ext x, simp [part.mem_eq, and.exists, -exists_prop] }

lemma pimage_union [decidable_eq α] : (s ∪ t).pimage f = s.pimage f ∪ t.pimage f :=
coe_inj.1 $ by simp only [coe_pimage, pfun.image_union, coe_union]

@[simp] lemma pimage_empty : pimage f ∅ = ∅ := by { ext, simp }

lemma pimage_subset {t : finset β} : s.pimage f ⊆ t ↔ ∀ (x ∈ s) (y ∈ f x), y ∈ t :=
by simp [subset_iff, @forall_swap _ β]

@[mono] lemma pimage_mono (h : s ⊆ t) : s.pimage f ⊆ t.pimage f :=
pimage_subset.2 $ λ x hx y hy, mem_pimage.2 ⟨x, h hx, hy⟩

lemma pimage_inter [decidable_eq α] : (s ∩ t).pimage f ⊆ s.pimage f ∩ t.pimage f :=
by simp only [← coe_subset, coe_pimage, coe_inter, pfun.image_inter]

end finset


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.power_series.basic
import Mathlib.data.nat.parity
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Definition of well-known power series

In this file we define the following power series:

* `power_series.inv_units_sub`: given `u : units R`, this is the series for `1 / (u - x)`.
  It is given by `∑ n, x ^ n /ₚ u ^ (n + 1)`.

* `power_series.sin`, `power_series.cos`, `power_series.exp` : power series for sin, cosine, and
  exponential functions.
-/

namespace power_series

/-- The power series for `1 / (u - x)`. -/
def inv_units_sub {R : Type u_1} [ring R] (u : units R) : power_series R :=
  mk fun (n : ℕ) => 1 /ₚ u ^ (n + 1)

@[simp] theorem coeff_inv_units_sub {R : Type u_1} [ring R] (u : units R) (n : ℕ) : coe_fn (coeff R n) (inv_units_sub u) = 1 /ₚ u ^ (n + 1) :=
  coeff_mk n fun (n : ℕ) => 1 /ₚ u ^ (n + 1)

@[simp] theorem constant_coeff_inv_units_sub {R : Type u_1} [ring R] (u : units R) : coe_fn (constant_coeff R) (inv_units_sub u) = 1 /ₚ u := sorry

@[simp] theorem inv_units_sub_mul_X {R : Type u_1} [ring R] (u : units R) : inv_units_sub u * X = inv_units_sub u * coe_fn (C R) ↑u - 1 := sorry

@[simp] theorem inv_units_sub_mul_sub {R : Type u_1} [ring R] (u : units R) : inv_units_sub u * (coe_fn (C R) ↑u - X) = 1 := sorry

theorem map_inv_units_sub {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R →+* S) (u : units R) : coe_fn (map f) (inv_units_sub u) = inv_units_sub (coe_fn (units.map ↑f) u) := sorry

/-- Power series for the exponential function at zero. -/
def exp (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk fun (n : ℕ) => coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n))

/-- Power series for the sine function at zero. -/
def sin (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk fun (n : ℕ) => ite (even n) 0 (coe_fn (algebra_map ℚ A) ((-1) ^ (n / bit0 1) / ↑(nat.factorial n)))

/-- Power series for the cosine function at zero. -/
def cos (A : Type u_1) [ring A] [algebra ℚ A] : power_series A :=
  mk fun (n : ℕ) => ite (even n) (coe_fn (algebra_map ℚ A) ((-1) ^ (n / bit0 1) / ↑(nat.factorial n))) 0

@[simp] theorem coeff_exp {A : Type u_1} [ring A] [algebra ℚ A] (n : ℕ) : coe_fn (coeff A n) (exp A) = coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n)) :=
  coeff_mk n fun (n : ℕ) => coe_fn (algebra_map ℚ A) (1 / ↑(nat.factorial n))

@[simp] theorem map_exp {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A] [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (exp A) = exp A' := sorry

@[simp] theorem map_sin {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A] [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (sin A) = sin A' := sorry

@[simp] theorem map_cos {A : Type u_1} {A' : Type u_2} [ring A] [ring A'] [algebra ℚ A] [algebra ℚ A'] (f : A →+* A') : coe_fn (map f) (cos A) = cos A' := sorry


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison

import category_theory.natural_isomorphism
import category_theory.whiskering
import category_theory.const
import category_theory.opposites
import category_theory.yoneda

universes v u u' -- declare the `v`'s first; see `category_theory.category` for an explanation

open category_theory

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

open category_theory
open category_theory.category
open category_theory.functor

namespace category_theory

namespace functor
variables {J C} (F : J ⥤ C)

/--
`F.cones` is the functor assigning to an object `X` the type of
natural transformations from the constant functor with value `X` to `F`.
An object representing this functor is a limit of `F`.
-/
def cones : Cᵒᵖ ⥤ Type v := (const J).op ⋙ (yoneda.obj F)

lemma cones_obj (X : Cᵒᵖ) : F.cones.obj X = ((const J).obj (unop X) ⟶ F) := rfl

@[simp] lemma cones_map_app {X₁ X₂ : Cᵒᵖ} (f : X₁ ⟶ X₂) (t : F.cones.obj X₁) (j : J) :
  (F.cones.map f t).app j = f.unop ≫ t.app j := rfl

/--
`F.cocones` is the functor assigning to an object `X` the type of
natural transformations from `F` to the constant functor with value `X`.
An object corepresenting this functor is a colimit of `F`.
-/
def cocones : C ⥤ Type v := const J ⋙ coyoneda.obj (op F)

lemma cocones_obj (X : C) : F.cocones.obj X = (F ⟹ (const J).obj X) := rfl

@[simp] lemma cocones_map_app {X₁ X₂ : C} (f : X₁ ⟶ X₂) (t : F.cocones.obj X₁) (j : J) :
  (F.cocones.map f t).app j = t.app j ≫ f := rfl

end functor

section
variables (J C)

def cones : (J ⥤ C) ⥤ (Cᵒᵖ ⥤ Type v) :=
{ obj := functor.cones,
  map := λ F G f, whisker_left (const J).op (yoneda.map f) }

def cocones : (J ⥤ C)ᵒᵖ ⥤ (C ⥤ Type v) :=
{ obj := λ F, functor.cocones (unop F),
  map := λ F G f, whisker_left (const J) (coyoneda.map f) }

variables {J C}

@[simp] lemma cones_obj (F : J ⥤ C) : (cones J C).obj F = F.cones := rfl
@[simp] lemma cones_map  {F G : J ⥤ C} {f : F ⟶ G} :
(cones J C).map f = (whisker_left (const J).op (yoneda.map f)) := rfl

@[simp] lemma cocones_obj (F : (J ⥤ C)ᵒᵖ) : (cocones J C).obj F = (unop F).cocones := rfl
@[simp] lemma cocones_map  {F G : (J ⥤ C)ᵒᵖ} {f : F ⟶ G} :
(cocones J C).map f = (whisker_left (const J) (coyoneda.map f)) := rfl

end

namespace limits

/--
A `c : cone F` is:
* an object `c.X` and
* a natural transformation `c.π : c.X ⟹ F` from the constant `c.X` functor to `F`.

`cone F` is equivalent, in the obvious way, to `Σ X, F.cones.obj X`.
-/
structure cone (F : J ⥤ C) :=
(X : C)
(π : (const J).obj X ⟹ F)

@[simp] lemma cone.w {F : J ⥤ C} (c : cone F) {j j' : J} (f : j ⟶ j') :
  c.π.app j ≫ F.map f = c.π.app j' :=
by convert ←(c.π.naturality f).symm; apply id_comp

/--
A `c : cocone F` is
* an object `c.X` and
* a natural transformation `c.ι : F ⟹ c.X` from `F` to the constant `c.X` functor.

`cocone F` is equivalent, in the obvious way, to `Σ X, F.cocones.obj X`.
-/
structure cocone (F : J ⥤ C) :=
(X : C)
(ι : F ⟹ (const J).obj X)

@[simp] lemma cocone.w {F : J ⥤ C} (c : cocone F) {j j' : J} (f : j ⟶ j') :
  F.map f ≫ c.ι.app j' = c.ι.app j :=
by convert ←(c.ι.naturality f); apply comp_id

variables {F : J ⥤ C}

namespace cone

@[simp] def extensions (c : cone F) : yoneda.obj c.X ⟶ F.cones :=
{ app := λ X f, ((const J).map f) ≫ c.π }

/-- A map to the vertex of a cone induces a cone by composition. -/
@[simp] def extend (c : cone F) {X : C} (f : X ⟶ c.X) : cone F :=
{ X := X,
  π := c.extensions.app (op X) f }

def whisker {K : Type v} [small_category K] (E : K ⥤ J) (c : cone F) : cone (E ⋙ F) :=
{ X := c.X,
  π := whisker_left E c.π }

@[simp] lemma whisker_π_app (c : cone F) {K : Type v} [small_category K] (E : K ⥤ J) (k : K) :
  (c.whisker E).π.app k = (c.π).app (E.obj k) := rfl
end cone

namespace cocone
@[simp] def extensions (c : cocone F) : coyoneda.obj (op c.X) ⟶ F.cocones :=
{ app := λ X f, c.ι ≫ ((const J).map f) }

/-- A map from the vertex of a cocone induces a cocone by composition. -/
@[simp] def extend (c : cocone F) {X : C} (f : c.X ⟶ X) : cocone F :=
{ X := X,
  ι := c.extensions.app X f }

def whisker {K : Type v} [small_category K] (E : K ⥤ J) (c : cocone F) : cocone (E ⋙ F) :=
{ X := c.X,
  ι := whisker_left E c.ι }

@[simp] lemma whisker_ι_app (c : cocone F) {K : Type v} [small_category K] (E : K ⥤ J) (k : K) :
  (c.whisker E).ι.app k = (c.ι).app (E.obj k) := rfl
end cocone

structure cone_morphism (A B : cone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, hom ≫ B.π.app j = A.π.app j . obviously)

restate_axiom cone_morphism.w'
attribute [simp] cone_morphism.w

@[extensionality] lemma cone_morphism.ext {A B : cone F} {f g : cone_morphism A B}
  (w : f.hom = g.hom) : f = g :=
by cases f; cases g; simpa using w

instance cone.category : category.{v} (cone F) :=
{ hom  := λ A B, cone_morphism A B,
  comp := λ X Y Z f g,
  { hom := f.hom ≫ g.hom,
    w' := by intro j; rw [assoc, g.w, f.w] },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cones
@[simp] lemma id.hom   (c : cone F) : (𝟙 c : cone_morphism c c).hom = 𝟙 (c.X) := rfl
@[simp] lemma comp.hom {c d e : cone F} (f : c ⟶ d) (g : d ⟶ e) :
  (f ≫ g).hom = f.hom ≫ g.hom := rfl

/-- To give an isomorphism between cones, it suffices to give an
  isomorphism between their vertices which commutes with the cone
  maps. -/
@[extensionality] def ext {c c' : cone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.π.app j = φ.hom ≫ c'.π.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.inv_comp_eq.mpr (w j) } }

def postcompose {G : J ⥤ C} (α : F ⟶ G) : cone F ⥤ cone G :=
{ obj := λ c, { X := c.X, π := c.π ⊟ α },
  map := λ c₁ c₂ f, { hom := f.hom, w' :=
  by intro; erw ← category.assoc; simp [-category.assoc] } }

@[simp] lemma postcompose_obj_X {G : J ⥤ C} (α : F ⟶ G) (c : cone F) :
  ((postcompose α).obj c).X = c.X := rfl

@[simp] lemma postcompose_obj_π {G : J ⥤ C} (α : F ⟶ G) (c : cone F) :
  ((postcompose α).obj c).π = c.π ⊟ α := rfl

@[simp] lemma postcompose_map_hom {G : J ⥤ C} (α : F ⟶ G) {c₁ c₂ : cone F} (f : c₁ ⟶ c₂):
  ((postcompose α).map f).hom = f.hom := rfl

def forget : cone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

@[simp] lemma forget_obj {t : cone F} : forget.obj t = t.X := rfl
@[simp] lemma forget_map {s t : cone F} {f : s ⟶ t} : forget.map f = f.hom := rfl

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

@[simp] def functoriality (G : C ⥤ D) : cone F ⥤ cone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    π := { app := λ j, G.map (A.π.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ X Y f,
  { hom := G.map f.hom,
    w'  := by intros; rw [←functor.map_comp, f.w] } }
end
end cones

structure cocone_morphism (A B : cocone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, A.ι.app j ≫ hom = B.ι.app j . obviously)

restate_axiom cocone_morphism.w'
attribute [simp] cocone_morphism.w

@[extensionality] lemma cocone_morphism.ext
  {A B : cocone F} {f g : cocone_morphism A B} (w : f.hom = g.hom) : f = g :=
by cases f; cases g; simpa using w

instance cocone.category : category.{v} (cocone F) :=
{ hom  := λ A B, cocone_morphism A B,
  comp := λ _ _ _ f g,
  { hom := f.hom ≫ g.hom,
    w' := by intro j; rw [←assoc, f.w, g.w] },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cocones
@[simp] lemma id.hom   (c : cocone F) : (𝟙 c : cocone_morphism c c).hom = 𝟙 (c.X) := rfl
@[simp] lemma comp.hom {c d e : cocone F} (f : c ⟶ d) (g : d ⟶ e) :
  (f ≫ g).hom = f.hom ≫ g.hom := rfl

/-- To give an isomorphism between cocones, it suffices to give an
  isomorphism between their vertices which commutes with the cocone
  maps. -/
@[extensionality] def ext {c c' : cocone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.ι.app j ≫ φ.hom = c'.ι.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.comp_inv_eq.mpr (w j).symm } }

def precompose {G : J ⥤ C} (α : G ⟶ F) : cocone F ⥤ cocone G :=
{ obj := λ c, { X := c.X, ι := α ⊟ c.ι },
  map := λ c₁ c₂ f, { hom := f.hom } }

@[simp] lemma precompose_obj_X {G : J ⥤ C} (α : G ⟶ F) (c : cocone F) :
  ((precompose α).obj c).X = c.X := rfl

@[simp] lemma precompose_obj_ι {G : J ⥤ C} (α : G ⟶ F) (c : cocone F) :
  ((precompose α).obj c).ι = α ⊟ c.ι := rfl

@[simp] lemma precompose_map_hom {G : J ⥤ C} (α : G ⟶ F) {c₁ c₂ : cocone F} (f : c₁ ⟶ c₂) :
  ((precompose α).map f).hom = f.hom := rfl

def forget : cocone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

@[simp] lemma forget_obj {t : cocone F} : forget.obj t = t.X := rfl
@[simp] lemma forget_map {s t : cocone F} {f : s ⟶ t} : forget.map f = f.hom := rfl

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

@[simp] def functoriality (G : C ⥤ D) : cocone F ⥤ cocone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    ι := { app := λ j, G.map (A.ι.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ _ _ f,
  { hom := G.map f.hom,
    w'  := by intros; rw [←functor.map_comp, cocone_morphism.w] } }
end
end cocones

end limits

namespace functor

variables {D : Type u'} [category.{v} D]
variables {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D)

open category_theory.limits

/-- The image of a cone in C under a functor G : C ⥤ D is a cone in D. -/
def map_cone   (c : cone F)   : cone (F ⋙ H)   := (cones.functoriality H).obj c
/-- The image of a cocone in C under a functor G : C ⥤ D is a cocone in D. -/
def map_cocone (c : cocone F) : cocone (F ⋙ H) := (cocones.functoriality H).obj c

def map_cone_morphism   {c c' : cone F}   (f : cone_morphism c c')   :
  cone_morphism   (H.map_cone c)   (H.map_cone c')   := (cones.functoriality H).map f
def map_cocone_morphism {c c' : cocone F} (f : cocone_morphism c c') :
  cocone_morphism (H.map_cocone c) (H.map_cocone c') := (cocones.functoriality H).map f

@[simp] lemma map_cone_π (c : cone F) (j : J) :
  (map_cone H c).π.app j = H.map (c.π.app j) := rfl
@[simp] lemma map_cocone_ι (c : cocone F) (j : J) :
  (map_cocone H c).ι.app j = H.map (c.ι.app j) := rfl

end functor

end category_theory


import tactic
import data.rel
import data.vector.basic
import data.nat.basic
import ruby.basic
import ruby.blocks
import ruby.tactics

open rel vector nat

variables {α β γ δ ε φ ψ : Type}

lemma seq_cong_right {r s : rel α β} {q : rel β γ} (h : r = s) : r ;; q = s ;; q := by rw h
lemma seq_cong_left {r s : rel β γ} {q : rel α β} (h : r = s) : q ;; r = q ;; s := by rw h

/- Fst and snd -/

abbreviation fst (r : rel α β) : rel (α × γ) (β × γ) := [r, idd]
abbreviation snd (r : rel α β) : rel (γ × α) (γ × β) := [idd, r]

lemma fst_eq (r : rel α β) {a : α} {b : β} {c d : γ} (h : (fst r) (a, c) (b, d)) : c = d := h.2
lemma snd_eq (r : rel α β) {a : α} {b : β} {c d : γ} (h : (snd r) (c, a) (d, b)) : c = d := h.1

lemma break_fst (r : rel α β) (s : rel β γ) : @fst α γ δ (r ;; s) = fst r ;; fst s
  := by simp [← seq_par_dist]

lemma break_snd (r : rel α β) (s : rel β γ) : @snd α γ δ (r ;; s) = snd r ;; snd s
  := by simp [← seq_par_dist]

@[simp]
lemma inv_fst (r : rel α β) : (fst r)† = @fst β α γ (r†) := by simp
@[simp]
lemma inv_snd (r : rel α β) : (snd r)† = @snd β α γ (r†) := by simp
@[simp]
lemma idd_fst : @fst α α β idd = idd := by { change [idd,idd] = idd, simp }
@[simp]
lemma idd_snd : @snd α α β idd = idd := by { change [idd,idd] = idd, simp }

lemma fst_snd_swap (r : rel α β)  (s : rel γ δ) : fst r ;; snd s = snd s ;; fst r :=
begin
  ext ⟨a,c⟩ ⟨b,d⟩,
  split,
  { rintro ⟨⟨x,y⟩,⟨⟨rax,h1⟩,⟨h2,syd⟩⟩⟩,
    use ⟨a,d⟩,
    simp * at *,
    exact ⟨⟨rfl,syd⟩,⟨rax,rfl⟩⟩, },
  { rintro ⟨⟨x,y⟩,⟨⟨h1,scy⟩,⟨rxb,h2⟩⟩⟩,
    use ⟨b,c⟩,
    simp * at *,
    exact ⟨⟨rxb,rfl⟩,⟨rfl,scy⟩⟩, }
end

lemma break_par (r : rel α β)  (s : rel γ δ) : [r, s] = fst r ;; snd s :=
begin
  ext ⟨a,c⟩ ⟨b,d⟩,
  split,
  rintro ⟨rab,scd⟩,
  use ⟨b,c⟩,
  exact ⟨⟨rab,rfl⟩,⟨rfl,scd⟩⟩,
  rintro ⟨⟨x,y⟩,⟨⟨rax,h1⟩,⟨h2,syd⟩⟩⟩,
  simp * at *,
  exact ⟨rax,syd⟩,
end

lemma break_par' (r : rel α β)  (s : rel γ δ) : [r, s] = snd s ;; fst r :=
begin
  rw ← fst_snd_swap r s,
  exact break_par r s,
end

/- Beside and below -/

def bes (r : rel (α × β) (δ × ψ)) (s : rel (ψ × γ) (ε × φ)) : rel (α × (β × γ)) ((δ × ε) × φ)
  := rsh ;; fst r ;; lsh ;; snd s ;; rsh

def bel (r : rel (α × ψ) (δ × ε)) (s : rel (β × γ) (ψ × φ)) : rel ((α × β) × γ) (δ × (ε × φ))
  := lsh ;; snd s ;; rsh ;; fst r ;; lsh

infixl `⟷`:70 := bes
infixl `↕`:70 := bel

/- Pow -/

def pow : rel α α → ℕ → rel α α
| r zero := idd
| r (succ n) := (pow r n) ;; r

instance rel_has_pow : has_pow (rel α α) ℕ :=
{ pow := pow }

def rel_pow_succ (r : rel α α) (n : ℕ) : r^(n+1) = r^n ;; r := rfl

@[simp]
lemma rel_pow_zero (r : rel α α) : r^0 = idd := rfl

@[simp]
lemma rel_pow_one (r : rel α α) : r^1 = r :=
begin
  change r^0 ;; r = r,
  simp,
end

@[simp]
lemma rel_pow_left (r : rel α α) (n : ℕ) : r ;; r^n = r^(n+1) :=
begin
  induction n with n hn,
  { simp, },
  { change r ;; (r^n ;; r) = r^(n+1) ;; r,
    rw ← hn,
    simp [rel_seq_assoc], }
end

@[simp]
lemma rel_pow_add (r : rel α α) (n m : ℕ) : r^n ;; r^m = r^(n+m) :=
begin
  induction m with m hm,
  { simp, },
  { change r^n ;; (r^m ;; r) = r^(n + m) ;; r,
    rw ← hm,
    simp [rel_seq_assoc], }
end

/- Map -/

def map : Π (n : ℕ), rel α β → rel (vector α n) (vector β n)
| zero r := nill
| (succ n) r := (apr n)† ;; [map n r, r] ;; apr n

lemma map_succ (r : rel α α) (n : ℕ) : map (n+1) r = (apr n)† ;; [map n r, r] ;; apr n := rfl

@[simp]
lemma rel_map_zero (r : rel α β) : map 0 r = nill := rfl

def map' : Π (n : ℕ), rel α β → rel (vector α n) (vector β n)
| zero r := nill
| (succ n) r := (apl n)† ;; [r, map' n r] ;; apl n

lemma map'_succ (r : rel α α) (n : ℕ) : map' (n+1) r = (apl n)† ;; [r, map' n r] ;; apl n := rfl

@[simp]
lemma rel_map'_zero (r : rel α β) : map' 0 r = nill := rfl

/- Tri -/

def tri : Π (n : ℕ), rel α α → rel (vector α n) (vector α n)
| zero r := nill
| (succ n) r := (apr n)† ;; [tri n r, r^n] ;; apr n

lemma tri_succ (r : rel α α) (n : ℕ) : tri (n+1) r = (apr n)† ;; [tri n r, r^n] ;; apr n := rfl

@[simp]
lemma tri_zero (r : rel α α) : tri 0 r = nill := rfl

theorem map_tri_comm (r : rel α α) (n : ℕ) : map n r ;; tri n r = tri n r ;; map n r :=
begin
  induction n with n hn,

  simp,

  have h : tri n.succ r;;map n.succ r = _;;[tri n r,r^n];;[map n r,r];;_,
  { calc tri n.succ r;;map n.succ r
      = _;;(apr n;;apr n†);;[map n r, r];;_ : by simp [map_succ, tri_succ, rel_seq_assoc]
  ... = _;;[tri n r,r^n];;[map n r,r];;_ : by simp [apr_inv_right] },

  calc map n.succ r;;tri n.succ r
      = _;;(apr n;;apr n†);;[tri n r,r ^ n];;_ : by simp [map_succ, tri_succ, rel_seq_assoc]
  ... = _;;([map n r,r];;[tri n r,r ^ n]);;_ : by simp [apr_inv_right, rel_seq_assoc]
  ... = _;;[tri n r ;; map n r,r^n;;r];;_ : by simp [← seq_par_dist, hn, rel_pow_succ]
  ... = tri n.succ r;;map n.succ r : by simp [h, rel_seq_assoc],

  /-
  { simp [map_succ, tri_succ],
    nth_rewrite 2 comp_assoc,
    nth_rewrite 5 comp_assoc,
    simp [apr_inv_right],
    nth_rewrite 1 comp_assoc,
    nth_rewrite 2 comp_assoc,
    simpa [← seq_par_dist, ← seq_par_dist, hn, rel_pow_left], }
  -/
end

def tri' : Π (n : ℕ), rel α α → rel (vector α n) (vector α n)
| zero r := nill
| (succ n) r := (apl n)† ;; [idd, tri' n r ;; map' n r] ;; apl n

lemma tri'_succ (r : rel α α) (n : ℕ) : tri' (n+1) r = (apl n)† ;; snd (tri' n r ;; map' n r) ;; apl n := rfl

@[simp]
lemma tri'_zero (r : rel α α) : tri' 0 r = nill := rfl

lemma map'_tri'_comm (r : rel α α) (n : ℕ) : map' n r ;; tri' n r = tri' n r ;; map' n r :=
begin
  induction n with n hn,
  simp,

  simp only [tri'_succ, map'_succ, assoc],
  apply seq_cong_left, repeat {rw ← assoc}, apply seq_cong_right,
  conv_lhs { l, arr, rw apl_inv_right, },
  conv_rhs { l, arr, rw apl_inv_right, },
  simp [← seq_par_dist, ← hn, assoc],
end

/-
lemma nil_append {n : ℕ} (xs : vector α n) : heq (append nil xs) xs :=
begin
  induction n with n hn,
  rw xs.eq_nil,
  simp,
  sorry
end

lemma splitvec {n : ℕ} (xs : vector α n) (x : α)
  : { v : α × vector α n | v.1 ::ᵥ v.2 = vector.append xs (x ::ᵥ nil) } :=
begin
  induction n with n hn,
  { rw xs.eq_nil,
    use ⟨x,nil⟩,
    dsimp,
    sorry, },
  sorry
end

theorem tri_eq_tri' (n : ℕ) (r : rel α α) : tri n r = tri' n r :=
begin
  induction n with n hn,
  simp,
  rw [tri_succ, tri'_succ, ← hn], clear hn,
  ext ps qs,
  split,
  { rintro ⟨⟨xs,x⟩,⟨⟨⟨ys,y⟩,⟨h1,⟨hl,hr⟩⟩⟩,h3⟩⟩,
    rcases splitvec xs x with ⟨⟨z,zs⟩,hz⟩,
    use ⟨z,zs⟩,
    unfold inv flip at h1 ⊢,
    rw apr_def at h3 h1,
    simp only [h3] at hz,
    refine ⟨_,hz⟩,
    rcases splitvec ys y with ⟨⟨w,ws⟩,hw⟩,
    use ⟨w,ws⟩,
    simp only [h1] at hw,
    dsimp,
    refine ⟨hw,_⟩,
    sorry },
  sorry
end
-/

/- Row -/

def row : Π (n : ℕ), rel (α × β) (γ × α) → rel (α × vector β n) (vector γ n × α)
| zero r := snd nill ;; @swap α (vector α 0) ;; fst nill
| (succ n) r := snd (apl n)† ;; (r ⟷ row n r) ;; fst (apl n)

def row_succ (n : ℕ) (r : rel (α × β) (γ × α))
  : row (n+1) r = snd (apl n)† ;; (r ⟷ row n r) ;; fst (apl n) := rfl

/- Reduce -/
/-
def rdl (n : ℕ) (r : rel (α × β) α) : rel (α × vector β n) α
  := row n (r ;; (@π₂ α α)†) ;; π₂

@[simp]
lemma rdl_zero (r : rel (α × β) α) : rdl 0 r = π₁ :=
begin
  ext ⟨x,xs⟩ y,
  unfold rdl row snd fst idd,
  simp,
  split,
  { rintro ⟨⟨vs,v⟩,⟨⟨⟨zs,z⟩,⟨⟨⟨w,ws⟩,⟨⟨h1,-⟩,h3⟩⟩,⟨-,h5⟩⟩⟩,h2⟩⟩,
    simp only [and_true, swap_def, eq_iff_true_of_subsingleton] at h3,
    have h' : w = z := by simpa using h3,
    rw [h1, h', h5],
    simpa only [π₂_def] using h2, },
  { intro h,
    use ⟨nil,y⟩,
    simp only [and_true, π₂_def, eq_self_iff_true],
    use ⟨nil,y⟩,
    split, swap, exact ⟨nill_def,rfl⟩,
    use ⟨y,nil⟩,
    simp only [and_true, swap_def, eq_self_iff_true],
    rw xs.eq_nil,
    exact ⟨h,nill_def⟩, }
end
-/

def rdl : Π (n : ℕ), rel (α × β) α → rel (α × vector β n) α
| zero r := π₁
| (succ n) r := snd (apl n)† ;; rsh ;; fst r ;; rdl n r

def rdl_succ (n : ℕ) (r : rel (α × β) α) : rdl (n+1) r = snd (apl n)† ;; rsh ;; fst r ;; rdl n r := rfl

@[simp]
lemma rdl_zero (r : rel (α × β) α) : rdl 0 r = π₁ := rfl

def rdl' (n : ℕ) (r : rel (α × β) α) : rel (α × vector β n) α
  := row n (r ;; (@π₂ α α)†) ;; π₂

@[simp]
lemma rdl'_zero (r : rel (α × β) α) : rdl' 0 r = π₁ :=
begin
  ext ⟨x,xs⟩ y,
  unfold rdl' row,
  simp,
  split,
  { rintro ⟨⟨vs,v⟩,⟨⟨⟨zs,z⟩,⟨⟨⟨w,ws⟩,⟨⟨h1,-⟩,h3⟩⟩,⟨-,h5⟩⟩⟩,h2⟩⟩,
    simp * at *, },
  { intro h,
    use ⟨nil,y⟩,
    simp * at *,
    use ⟨nil,y⟩,
    split, swap, exact ⟨nill_def,rfl⟩,
    use ⟨y,nil⟩,
    simp only [and_true, swap_def, eq_self_iff_true],
    rw xs.eq_nil,
    exact ⟨rfl,nill_def⟩, }
end


import QL.FOL.deduction

-- Prenex normal form

universes u v

namespace fol
open_locale logic_symbol aclogic
open subformula

variables (L : language.{u}) (m n : ℕ)

inductive pnf (m : ℕ) : ℕ → Type u
| openformula {n} : Π p : subformula L m n, p.is_open → pnf n
| fal         {n} : pnf (n + 1) → pnf n
| ex          {n} : pnf (n + 1) → pnf n

variables {L m n}

namespace pnf

instance : inhabited (pnf L m n) := ⟨openformula ⊤ (by simp)⟩

instance : has_univ_quantifier' (pnf L m) := ⟨@pnf.fal L m⟩

lemma fal_eq (φ : pnf L m (n + 1)) : φ.fal = ∀'φ := rfl

instance : has_exists_quantifier' (pnf L m) := ⟨@pnf.ex L m⟩

lemma ex_eq (φ : pnf L m (n + 1)) : φ.ex = ∃'φ := rfl

def to_str [∀ n, has_to_string (L.fn n)] [∀ n, has_to_string (L.pr n)] : Π {n}, pnf L m n → string
| n (openformula p _) := "[" ++ to_string p ++ "]"
| n (fal φ)           := "∀" ++ to_str φ
| n (ex φ)            := "∃" ++ to_str φ

instance [∀ n, has_to_string (L.fn n)] [∀ n, has_to_string (L.pr n)] : has_to_string (pnf L m n) := ⟨@to_str L m _ _ n⟩

@[simp] def rank : Π {n}, pnf L m n → ℕ
| n (openformula p hp) := 0
| n (fal φ)            := φ.rank + 1
| n (ex  φ)            := φ.rank + 1

@[simp] lemma rank_forall (φ : pnf L m (n + 1)) : rank (∀'φ) = rank φ + 1 := by simp[has_univ_quantifier'.univ]

@[simp] lemma rank_exists (φ : pnf L m (n + 1)) : rank (∃'φ) = rank φ + 1 := by simp[has_exists_quantifier'.ex]

@[simp] lemma forall_inj (p q : pnf L m (n + 1)) : ∀'p = ∀'q ↔ p = q := ⟨fal.inj, congr_arg _⟩

@[simp] lemma exists_inj (p q : pnf L m (n + 1)) : ∃'p = ∃'q ↔ p = q := ⟨ex.inj, congr_arg _⟩

@[simp] def to_formula : Π {n}, pnf L m n → subformula L m n
| n (openformula p hp) := p
| n (fal φ)            := ∀'to_formula φ
| n (ex  φ)            := ∃'to_formula φ

--instance : has_coe (pnf L m n) (subformula L m n) := ⟨@to_formula L m n⟩

@[simp] lemma to_formula_forall (φ : pnf L m (n + 1)) : to_formula (∀'φ) = ∀'(to_formula φ) := by simp[has_univ_quantifier'.univ]

@[simp] lemma to_formula_exists (φ : pnf L m (n + 1)) : to_formula (∃'φ) = ∃'(to_formula φ) := by simp[has_exists_quantifier'.ex]

@[simp] lemma to_formula_univ_closure (φ : pnf L m n) : to_formula (∀'*φ) = ∀'*(to_formula φ) :=
by induction n; simp*

section rew
variables {m₁ m₂ : ℕ} (s : fin m₁ → subterm L m₂ n)

@[simp] def rew : Π {n} (s : fin m₁ → subterm L m₂ n), pnf L m₁ n → pnf L m₂ n
| n s (openformula p hp) := openformula (subformula.rew s p) (by simpa using hp)
| n s (fal φ)            := ∀'φ.rew (subterm.lift ∘ s)
| n s (ex  φ)            := ∃'φ.rew (subterm.lift ∘ s)

@[simp] lemma rew_forall (φ : pnf L m₁ (n + 1)) : rew s (∀'φ) = ∀'(rew (subterm.lift ∘ s) φ) := by simp[has_univ_quantifier'.univ]

@[simp] lemma rew_exists (φ : pnf L m₁ (n + 1)) : rew s (∃'φ) = ∃'(rew (subterm.lift ∘ s) φ) := by simp[has_exists_quantifier'.ex]

@[simp] def rew_to_formula : Π {n} (s : fin m₁ → subterm L m₂ n) (φ : pnf L m₁ n),
  (rew s φ).to_formula = subformula.rew s φ.to_formula
| n s (openformula p hp) := by simp
| n s (fal φ)            := by simp[rew_to_formula _ φ]
| n s (ex  φ)            := by simp[rew_to_formula _ φ]

@[simp] def rank_rew : Π {n} (s : fin m₁ → subterm L m₂ n) (φ : pnf L m₁ n), (rew s φ).rank = φ.rank
| n s (openformula p hp) := by simp
| n s (fal φ)            := by simp[rank_rew _ φ]
| n s (ex  φ)            := by simp[rank_rew _ φ]

end rew

section mlift

@[simp] def mlift : Π {n}, pnf L m n → pnf L (m + 1) n
| n (openformula p hp) := openformula p.mlift (by simpa using hp)
| n (fal φ)            := fal (mlift φ)
| n (ex  φ)            := ex (mlift φ)

@[simp] lemma mlift_forall (φ : pnf L m (n + 1)) : mlift (∀'φ) = ∀'(mlift φ) := by simp[has_univ_quantifier'.univ]

@[simp] lemma mlift_exists (φ : pnf L m (n + 1)) : mlift (∃'φ) = ∃'(mlift φ) := by simp[has_exists_quantifier'.ex]

@[simp] lemma mlift_to_formula : ∀ {n} (φ : pnf L m n), φ.mlift.to_formula = 𝗟 φ.to_formula
| _ (openformula p hp) := by simp
| _ (fal φ)            := by simp; exact mlift_to_formula φ
| _ (ex φ)             := by simp; exact mlift_to_formula φ

@[simp] lemma rank_mlift : ∀ {n} (φ : pnf L m n), rank (mlift φ) = rank φ
| n (openformula p hp) := by simp
| n (fal p) := by show (∀'p).mlift.rank = p.fal.rank; simpa using rank_mlift p
| n (ex p)  := by show (∃'p).mlift.rank = p.ex.rank; simpa  using rank_mlift p

end mlift

section push

@[simp] def push : Π {n}, pnf L m (n + 1) → pnf L (m + 1) n
| n (openformula p hp) := openformula p.push (by simpa using hp)
| n (fal φ)            := fal (push φ)
| n (ex  φ)            := ex (push φ)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

@[simp] lemma push_forall (φ : pnf L m (n + 1 + 1)) : push (∀'φ) = ∀'(push φ) := by simp[has_univ_quantifier'.univ]

@[simp] lemma push_exists (φ : pnf L m (n + 1 + 1)) : push (∃'φ) = ∃'(push φ) := by simp[has_exists_quantifier'.ex]

@[simp] lemma push_to_formula : ∀ {n} (φ : pnf L m (n + 1)), φ.push.to_formula = 𝗠 φ.to_formula
| _ (openformula p hp) := by simp
| _ (fal φ)            := by simp; exact push_to_formula φ
| _ (ex φ)             := by simp; exact push_to_formula φ
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

@[simp] lemma rank_push : ∀ {n} (φ : pnf L m (n + 1)), rank (push φ) = rank φ
| n (openformula p hp) := by simp
| n (fal p) := by show (∀'p).push.rank = p.fal.rank; simpa using rank_push p
| n (ex p) := by show (∃'p).push.rank = p.ex.rank; simpa using rank_push p
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

end push

section pull

@[simp] def pull : Π {n}, pnf L (m + 1) n → pnf L m (n + 1)
| n (openformula p hp) := openformula p.pull (by simpa using hp)
| n (fal φ)            := fal (pull φ)
| n (ex  φ)            := ex (pull φ)

@[simp] lemma pull_forall (φ : pnf L (m + 1) (n + 1)) : pull (∀'φ) = ∀'(pull φ) := by simp[has_univ_quantifier'.univ]

@[simp] lemma pull_exists (φ : pnf L (m + 1) (n + 1)) : pull (∃'φ) = ∃'(pull φ) := by simp[has_exists_quantifier'.ex]

@[simp] lemma pull_to_formula : ∀ {n} (φ : pnf L (m + 1) n), φ.pull.to_formula = 𝗡 φ.to_formula
| _ (openformula p hp) := by simp
| _ (fal φ)            := by simp; exact pull_to_formula φ
| _ (ex φ)             := by simp; exact pull_to_formula φ

@[simp] lemma pull_push : ∀ {n} (φ : pnf L (m + 1) n), φ.pull.push = φ
| _ (openformula p hp) := by simp
| _ (fal φ)            := by simpa using pull_push φ
| _ (ex φ)             := by simpa using pull_push φ

@[simp] lemma push_pull : ∀ {n} (φ : pnf L m (n + 1)), φ.push.pull = φ
| _ (openformula p hp) := by simp
| _ (fal φ)            := by simpa using push_pull φ
| _ (ex φ)             := by simpa using push_pull φ
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

lemma foralls_comm (φ : pnf L m (n + 1)) : ∀'*(∀'φ) = ∀'(∀'*φ.push).pull :=
by { induction n with n IH generalizing m, { simp }, { simpa using IH (∀'φ) } }

lemma exists_comm (φ : pnf L m (n + 1)) : ∃'*(∃'φ) = ∃'(∃'*φ.push).pull :=
by { induction n with n IH generalizing m, { simp }, { simpa using IH (∃'φ) } }

end pull

section subst

def msubst (u : subterm L m n) : pnf L (m + 1) n → pnf L m n := rew (subterm.metavar <* u)

def subst (u : subterm L m n) : pnf L m (n + 1) → pnf L m n := msubst u ∘ push

@[simp] lemma msubst_openformula (u) (p : subformula L (m + 1) n) (hp) :
  msubst u (openformula p hp) = openformula (subformula.msubst u p) (by simpa using hp) :=
by simp[msubst, fin.comp_right_concat]; refl

@[simp] lemma msubst_fal (u) (φ : pnf L (m + 1) (n + 1)) : msubst u (∀'φ) = ∀'msubst u.lift φ :=
by simp[msubst, fin.comp_right_concat]; refl

@[simp] lemma msubst_ex (u) (φ : pnf L (m + 1) (n + 1)) : msubst u (∃'φ) = ∃'msubst u.lift φ :=
by simp[msubst, fin.comp_right_concat]

@[simp] def msubat_to_formula (u) (φ : pnf L (m + 1) n) :
  (msubst u φ).to_formula = subformula.msubst u φ.to_formula :=
by simp[msubst]; refl

@[simp] def rank_msubat (u) (φ : pnf L (m + 1) n) : (msubst u φ).rank = φ.rank :=
by simp[msubst]

end subst

section dummy

def dummy : pnf L m n → pnf L m (n + 1) := pull ∘ mlift

@[simp] lemma push_dummy (φ : pnf L m n) : push (dummy φ) = mlift φ :=
by simp[dummy]

lemma dummy_openformula (p : subformula L m n) (hp) :
  dummy (openformula p hp) = openformula p.dummy (by simpa using hp) := by simp[dummy]; refl

@[simp] lemma dummy_forall (φ : pnf L m (n + 1)) : dummy (∀'φ) = ∀'(dummy φ) := by simp[dummy]

@[simp] lemma dummy_exists (φ : pnf L m (n + 1)) : dummy (∃'φ) = ∃'(dummy φ) := by simp[dummy]

@[simp] lemma dummy_to_formula (φ : pnf L m n) : φ.dummy.to_formula = 𝗗 φ.to_formula :=
by simp[mlift_to_formula, pull_to_formula, dummy, subformula.dummy]

@[simp] lemma rank_dummy : ∀ {n} (φ : pnf L m n), rank (dummy φ) = rank φ
| n (openformula p hp) := by simp[dummy_openformula]
| n (fal p) := by show (∀'p).dummy.rank = p.fal.rank; simpa using rank_dummy p
| n (ex p) := by show (∃'p).dummy.rank = p.ex.rank; simpa using rank_dummy p

end dummy

section forall_pnf

inductive forall_pnf : ∀ {n}, pnf L m n → Prop
| openformula : ∀ {n} (p : subformula L m n) hp, forall_pnf (openformula p hp)
| fal : ∀ {n} {φ : pnf L m (n + 1)}, forall_pnf φ → forall_pnf (∀'φ)

attribute [simp] forall_pnf.openformula

@[simp] lemma forall_pnf_fal_iff (φ : pnf L m (n + 1)) : forall_pnf (∀'φ) ↔ forall_pnf φ :=
⟨by { rintros ⟨⟩, assumption }, by { intros h, exact h.fal }⟩

@[simp] lemma not_forall_pnf_ex (φ : pnf L m (n + 1)) : ¬forall_pnf (∃'φ) :=
by rintros ⟨⟩

@[simp] lemma forall_pnf_push_iff : ∀ {n} (φ : pnf L m (n + 1)), forall_pnf (push φ) ↔ forall_pnf φ
| n (openformula p hp) := by simp
| n (fal φ)            := by simp[fal_eq, forall_pnf_push_iff φ]
| n (ex φ)             := by simp[ex_eq]
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

@[simp] lemma forall_pnf_pull_iff : ∀ {n} (φ : pnf L (m + 1) n), forall_pnf (pull φ) ↔ forall_pnf φ
| n (openformula p hp) := by simp
| n (fal φ)            := by simp[fal_eq, forall_pnf_pull_iff φ]
| n (ex φ)             := by simp[ex_eq]

@[simp] lemma forall_pnf_msubst_iff : ∀ {n} (u) (φ : pnf L (m + 1) n), forall_pnf (msubst u φ) ↔ forall_pnf φ
| n u (openformula p hp) := by simp
| n u (fal φ)            := by simp[fal_eq]; exact forall_pnf_msubst_iff u.lift φ
| n u (ex φ)             := by simp[ex_eq]

@[simp] lemma forall_pnf_univ_closure (φ : pnf L m n) : forall_pnf (∀'*φ) ↔ forall_pnf φ :=
by induction n with n IH; simp*

@[simp] def open_form : Π {m} (φ : pnf L m 0), subformula L m φ.rank
| m (openformula p hp) := p
| m (fal φ)            :=
    by rw[show φ.fal.rank = φ.push.rank + 1, by simp]; exact (open_form φ.push).pull
| m (ex  φ)            :=
    by rw[show φ.ex.rank = φ.push.rank + 1, by simp]; exact (open_form φ.push).pull
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

lemma univ_closure_of_forall_pnf : ∀ {m} (φ : pnf L m 0), forall_pnf φ →
  ∃ (n) (p : subformula L m n) (hp : is_open p), φ = ∀'*(openformula p hp)
| m (openformula p hp) _ :=⟨0, p, hp, by simp⟩
| m (fal φ)            h :=
    begin
      have : ∃ n (p : subformula L (m + 1) n) (hp : p.is_open), φ.push = ∀'* (openformula p hp),
      from univ_closure_of_forall_pnf φ.push (by simpa[fal_eq] using h),
      rcases this with ⟨n, p, hp, h⟩,
      refine ⟨n + 1, p.pull, by simpa using hp, by simpa[fal_eq, foralls_comm] using congr_arg pull h⟩
    end
| m (ex φ)            h := by simp[ex_eq] at h; contradiction
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.1.rank)⟩]}

@[simp] def kernel : ∀ {n} (φ : pnf L m n), Σ n, subformula L m n
| n (openformula p hp) := ⟨n, p⟩
| n (fal φ)            := φ.kernel
| n (ex φ)             := φ.kernel

lemma kernel_eq_rank : ∀ {n} (φ : pnf L m n), φ.kernel.1 = φ.rank + n
| n (openformula p hp) := by simp
| n (fal φ)            := by simp[kernel_eq_rank φ, add_assoc, add_comm]
| n (ex φ)             := by simp[kernel_eq_rank φ, add_assoc, add_comm]

@[simp] lemma kernel_is_open : ∀ {n} (φ : pnf L m n), φ.kernel.2.is_open
| n (openformula p hp) := hp
| n (fal φ)            := kernel_is_open φ
| n (ex φ)             := kernel_is_open φ

lemma univ_closure_to_formula (φ : pnf L m 0) (h : forall_pnf φ) :
  ∃ (n) (p : subformula L m n) (hp : is_open p), φ.to_formula = ∀'*p :=
by { rcases univ_closure_of_forall_pnf φ h with ⟨n, p, hp, rfl⟩,
     refine ⟨n, p, hp, by simp⟩ }

end forall_pnf

@[simp] def neg : Π {m n}, pnf L m n → pnf L m n
| m n (openformula p hp) := openformula (∼p) (by simpa[is_open] using hp)
| m n (fal φ)            := ∃'(pull $ neg $ push φ)
| m n (ex φ)             := ∀'(pull $ neg $ push φ)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.rank)⟩]}

@[simp] def imply : Π {m n}, pnf L m n → pnf L m n → pnf L m n
| m n (openformula p hp) (openformula q hq) := openformula (p ⟶ q) (by simp; exact ⟨hp, hq⟩)
| m n (openformula p hp) (fal ψ)            := ∀'pull (imply (mlift $ openformula p hp) (push ψ))
| m n (openformula p hp) (ex ψ)             := ∃'pull (imply (mlift $ openformula p hp) (push ψ))
| m n (fal φ)            ψ                  := ∃'pull (imply (push φ) (mlift ψ))
| m n (ex φ)             ψ                  := ∀'pull (imply (push φ) (mlift ψ))
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.1.rank + x.2.2.2.rank)⟩]}

open axiomatic_classical_logic' axiomatic_classical_logic provable

lemma equiv_to_formula_neg : ∀ {m} (T : preTheory L m) (p : pnf L m 0), T ⊢ (p.neg).to_formula ⟷ ∼p.to_formula
| m T (openformula p hp) := by simp
| m T (pnf.fal φ) :=
    begin
      simp, show T ⊢ ∃'𝗡 φ.push.neg.to_formula ⟷ ∼∀'φ.to_formula,
      have : 𝗟'T ⊢ φ.push.neg.to_formula ⟷ ∼𝗠 φ.to_formula, by simpa using equiv_to_formula_neg 𝗟'T φ.push,
      have : T ⊢ ∃'𝗡 φ.push.neg.to_formula ⟷ ∃'∼φ.to_formula, by simpa using equiv_exists_of_equiv' this,
      refine equiv_trans this (equiv_symm $ neg_forall_pnf _)
    end
| m T (pnf.ex φ) :=
    begin
      simp, show T ⊢ ∀'𝗡 φ.push.neg.to_formula ⟷ ∼∃'φ.to_formula,
      have : 𝗟'T ⊢ φ.push.neg.to_formula ⟷ ∼𝗠 φ.to_formula, by simpa using equiv_to_formula_neg 𝗟'T φ.push,
      have : T ⊢ ∀'𝗡 φ.push.neg.to_formula ⟷ ∀'∼φ.to_formula, by simpa using equiv_forall_of_equiv' this,
      refine equiv_trans this (equiv_symm $ neg_exists_pnf _)
    end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.rank)⟩]}

lemma equiv_to_formula_imply : ∀ {m} (T : preTheory L m) (p q : pnf L m 0),
  T ⊢ (p.imply q).to_formula ⟷ (p.to_formula ⟶ q.to_formula)
| m T (openformula p hp) (openformula q hq) := by simp
| m T (openformula p hp) (fal ψ)            :=
    let φ := openformula p hp in
    begin
      simp, show T ⊢ (∀'𝗡 (φ.mlift.imply ψ.push).to_formula) ⟷ (p ⟶ ∀'ψ.to_formula),
      have : 𝗟'T ⊢ (φ.mlift.imply ψ.push).to_formula ⟷ (𝗟 p ⟶ 𝗠 ψ.to_formula),
      by simpa using equiv_to_formula_imply 𝗟'T φ.dummy.push ψ.push,
      have : T ⊢ ∀'𝗡 (φ.mlift.imply ψ.push).to_formula ⟷ ∀'(𝗗 p ⟶ ψ.to_formula),
      by simpa using equiv_forall_of_equiv' this,
      refine equiv_trans this (equiv_symm $ imply_forall_pnf _ _)
    end
| m T (openformula p hp) (ex ψ)             :=
    let φ := openformula p hp in
    begin
      simp, show T ⊢ (∃'𝗡 (φ.mlift.imply ψ.push).to_formula) ⟷ (p ⟶ ∃'ψ.to_formula),
      have : 𝗟'T ⊢ (φ.mlift.imply ψ.push).to_formula ⟷ (𝗟 p ⟶ 𝗠 ψ.to_formula),
      by simpa using equiv_to_formula_imply 𝗟'T φ.dummy.push ψ.push,
      have : T ⊢ ∃'𝗡 (φ.mlift.imply ψ.push).to_formula ⟷ ∃'(𝗗 p ⟶ ψ.to_formula),
      by simpa using equiv_exists_of_equiv' this,
      refine equiv_trans this (equiv_symm $ imply_exists_pnf _ _)
    end
| m T (fal φ)            ψ                  :=
    begin
      simp, show T ⊢ (∃'𝗡 (φ.push.imply ψ.mlift).to_formula) ⟷ (∀'φ.to_formula ⟶ ψ.to_formula),
      have : 𝗟'T ⊢ (φ.push.imply ψ.mlift).to_formula ⟷ (𝗠 φ.to_formula ⟶ 𝗟 ψ.to_formula),
      by simpa using equiv_to_formula_imply 𝗟'T φ.push ψ.mlift,
      have : T ⊢ ∃'𝗡 (φ.push.imply ψ.mlift).to_formula ⟷ ∃'(φ.to_formula ⟶ 𝗗 ψ.to_formula),
      by simpa using equiv_exists_of_equiv' this,
      refine equiv_trans this (equiv_symm $ forall_imply_pnf _ _)
    end
| m T (ex φ)             ψ                  :=
    begin
      simp, show T ⊢ (∀'𝗡 (φ.push.imply ψ.mlift).to_formula) ⟷ (∃'φ.to_formula ⟶ ψ.to_formula),
      have : 𝗟'T ⊢ (φ.push.imply ψ.mlift).to_formula ⟷ (𝗠 φ.to_formula ⟶ 𝗟 ψ.to_formula),
      by simpa using equiv_to_formula_imply 𝗟'T φ.push ψ.mlift,
      have : T ⊢ ∀'𝗡 (φ.push.imply ψ.mlift).to_formula ⟷ ∀'(φ.to_formula ⟶ 𝗗 ψ.to_formula),
      by simpa using equiv_forall_of_equiv' this,
      refine equiv_trans this (equiv_symm $ exists_imply_pnf _ _)
    end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.1.rank + x.2.2.2.rank)⟩]}

--instance : has_logic_symbol (pnf L m n) := logic_simbol_default (pnf L m n) (openformula ⊤ (by simp)) neg imply

end pnf

namespace subformula
open pnf axiomatic_classical_logic' axiomatic_classical_logic provable
variables {L m n} (T : preTheory L m)

@[simp] def to_pnf : Π {m n}, subformula L m n → pnf L m n
| m n verum          := openformula ⊤ (by simp)
| m n (relation r v) := openformula (relation r v) (by simp)
| m n (imply p q)    := (to_pnf p).imply (to_pnf q)
| m n (neg p)        := (to_pnf p).neg
| m n (fal p)        := ∀'pnf.pull (to_pnf (𝗠 p))
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.complexity)⟩]}

def normalize (p : subformula L m n) : subformula L m n := p.to_pnf.to_formula

@[simp] lemma to_pnf_top : to_pnf (⊤ : subformula L m n) = openformula ⊤ (by simp) := by unfold has_top.top; simp; refl

@[simp] lemma to_pnf_imply (p q : subformula L m n) : to_pnf (p ⟶ q) = (to_pnf p).imply (to_pnf q) :=
by unfold has_arrow.arrow; simp; refl

@[simp] lemma to_pnf_neg (p : subformula L m n) : to_pnf (∼p) = (to_pnf p).neg :=
by unfold has_negation.neg; simp; refl

@[simp] lemma to_pnf_fal (p : subformula L m (n + 1)) : to_pnf (∀'p) = ∀'(pnf.pull $ to_pnf $ 𝗠 p) :=
by unfold has_univ_quantifier'.univ; simp; refl

end subformula

section
open pnf subformula axiomatic_classical_logic' axiomatic_classical_logic provable

lemma equiv_normalize : ∀ {m} (T : preTheory L m) (p), T ⊢ normalize p ⟷ p
| m T verum          := by simp[top_eq, normalize]
| m T (relation r v) := by simp[normalize]
| m T (imply p q)    := by {
    simp[imply_eq, normalize],
    have : T ⊢ (p.to_pnf.imply q.to_pnf).to_formula ⟷ (p.normalize ⟶ q.normalize),
    from equiv_to_formula_imply T p.to_pnf q.to_pnf,
    exact equiv_trans this (equiv_imply_of_equiv (equiv_normalize T p) (equiv_normalize T q)) }
| m T (neg p)        := by {
    simp[neg_eq, normalize],
    have : T ⊢ p.to_pnf.neg.to_formula ⟷ ∼p.normalize, from equiv_to_formula_neg T p.to_pnf,
    exact equiv_trans this (equiv_neg_of_equiv (equiv_normalize T p)) }
| m T (fal p)        := by {
    simp[subformula.fal_eq, normalize],
    have : 𝗟'T ⊢ (𝗠 p).normalize ⟷ 𝗠 p, by simpa using equiv_normalize 𝗟'T p.push,
    exact equiv_forall_of_equiv (by simpa using this) }
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.complexity)⟩]}

end

end fol