BeginPackage["GC`",{
  "Local`","Profile`","Graph`","IHX`","Subspace`"
}]

$MaxValency=256

dK[g_Graph,i_Integer] := Module[
  {ng,j,k,rule,oddvs,sign,p,l=Length[g]},
  {j,k}=List @@ g[[i]];
  If[Length[g[[j]]]+Length[g[[k]]]-2 > $MaxValency, 0,
    oddvs=Flatten[Position[g,_?OddVertexQ]];
    sign=(-1)^(Plus @@ Flatten[Position[oddvs,#]& /@ {k,j}]);
    sign *= Sign[k-j];
    ng=Prepend[
      Delete[g,{{i},{j},{k}}],
      DeleteCases[g[[j]]~Join~g[[k]],i]
    ];
    rule=1+Range[l];
    Do[--(rule[[p]]), {p,i,l}];
    Do[--(rule[[p]]), {p,j,l}];
    Do[--(rule[[p]]), {p,k,l}];
    rule[[j]]=rule[[k]]=1;
    ng=Map[Replace[#,p_Integer :> rule[[p]]]&, ng, {2}];
    sign*ng
  ]
]

dK[g_Graph] := Plus @@ (dK[g,#]& /@ Flatten[Position[g,_Arrow]])

dK[x_] := (x /. g_Graph -> dK[g]) /; Head[x]=!=Graph

Contractions[g_Graph] := DeleteCases[
  dK[g,#]& /@ Flatten[Position[g,_Arrow]],
  0
]

CC2GC[g_Graph] := Module[
  {v,i},
  g /. {
    OV->OddUOV, Dashed->Arrow,
    v_Symbol[i_] :> ToExpression["Odd"~StringJoin~ToString[v]][i]}
]

GC[ig_Graph] := Module[
  {i,j,d=0,g,b,z,c,rule,dg,ng,PreChains,bg},
  PreChains[0] = CC2GC /@ First[Make[ig,
    SolveIHX -> False,AllGraphsGiven -> False,
    Relations -> {}, TryUOVs -> True,
    HashTableLength -> Prime[150]
  ]];
  Chains[0]=Select[CanonicalForm /@ PreChains[0], (!MatchQ[#,Hold[0*_]])&];
  Print["\n"];
  c[0]=Length[Chains[0]];
  b[0]=0;
  While[c[d]>0,
    Print[StringForm["dim Chains[``]=``",d,c[d]]];
    Chains[d+1]={}; PreChains[d+1]={};
    Do[
      dg=Select[
        Contractions[PreChains[d][[i]]],
        FreeQ[#,Arrow[j_,j_]]&
      ];
      Do[
        ng=CanonicalForm[dg[[j]]];
        PreChains[d+1]=PreChains[d+1]~Union~{bg=BareGraph[ng]};
        If[FreeQ[ng,Hold[0*_Graph]], Chains[d+1]=Chains[d+1]~Union~{bg}],
        {j,Length[dg]}
      ],
      {i,Length[PreChains[d]]}
    ];
Print[Length[PreChains[d+1]]];
    c[d+1]=Length[Chains[d+1]];
    rule=Dispatch[Thread[Rule[Chains[d+1],G /@ Range[c[d+1]]]]];
    dKChains[d]=Map[
      (Expand[ReleaseHold[dK[#] /. g_Graph :> CanonicalForm[g]]] /. rule)&,
      Chains[d]
    ];
    BoundariesSubspace[d+1]=NewSubspace[c[d+1]];
    AddVector[BoundariesSubspace[d+1],# /. G -> BasisVector]& /@ dKChains[d];
    b[d+1]=AddVector[BoundariesSubspace[d+1],0];
    Print[StringForm["dim Cycles[``]=``",d,z[d]=c[d]-b[d+1]]];
    Print[StringForm["dim Boundaries[``]=``",d,b[d]]];
    Print[StringForm["dim Homology[``]=``\n",d,z[d]-b[d]]];
    ++d;
  ]
]

Boundaries[d_] := SubspaceBasis[BoundariesSubspace[d+1]] /. {
  BasisVector[i_] :> Chains[d][[i]]
}

GC[m_,cols_List] := GC[BSeedGraph[m,cols]]

GC2EasyG[g_Graph] := DeleteCases[g,_Arrow] /. OddUOV -> V

save[fname_] := (
  For[ i=0, Length[Chains[i]] > 0, ++i,
    Gs[i] = GC2EasyG /@ Chains[i];
    d[i] = dKChains[i]
  ];
  Save[fname,Gs,d]
)
  

EndPackage[]
