Pensieve header: An implementation of the partial quadratic signature formalism for tangles; with Jessica Liu.

SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\LiuJ"];
<<KnotTheory`

Kas[X[i_,j_,k_,l_]]:=If[PositiveQ@X[i,j,k,l],
Kas[Perm[{-i,j,k,-l}],PQ[{(Subscript[y, -i]),(Subscript[y, j]),(Subscript[y, k]),(Subscript[y, -l])},{(Subscript[y, -i]),(Subscript[y, j]),(Subscript[y, k]),(Subscript[y, -l])},
(Subscript[η, -i]^2)+2 u (Subscript[η, -i]) (Subscript[η, j])+v (Subscript[η, j]^2)+2 (Subscript[η, -i]) (Subscript[η, k])+2 u (Subscript[η, j]) (Subscript[η, k])+(Subscript[η, k]^2)+2 u (Subscript[η, -i]) (Subscript[η, -l])+2 (Subscript[η, j]) (Subscript[η, -l])+2 u (Subscript[η, k]) (Subscript[η, -l])+v (Subscript[η, -l]^2)]],
Kas[Perm[{-i,-j,k,l}],PQ[{(Subscript[y, -j]),(Subscript[y, k]),(Subscript[y, l]),(Subscript[y, -i])},{(Subscript[y, -j]),(Subscript[y, k]),(Subscript[y, l]),(Subscript[y, -i])},
-v (Subscript[η, -i]^2)-2 u (Subscript[η, -i]) (Subscript[η, -j])-(Subscript[η, -j]^2)-2 (Subscript[η, -i]) (Subscript[η, k])-2 u (Subscript[η, -j]) (Subscript[η, k])-v (Subscript[η, k]^2)-2 u (Subscript[η, -i]) (Subscript[η, l])-2 (Subscript[η, -j]) (Subscript[η, l])-2 u (Subscript[η, k]) (Subscript[η, l])-(Subscript[η, l]^2)]]
]

CF[Subspace[{},{0...}]]:=Subspace[{},{}];
CF[Subspace[vs_,{}]]:=Subspace[Sort[vs],{}];
CF[Subspace[vs_,gens_]]:=Module[{cvs=Sort[vs]},
Subspace[cvs,
DeleteCases[RowReduce[Table[Coefficient[g,v],{g,gens},{v,cvs}]].cvs,0]
]]

CF[Subspace[{y,z,x,w},{x+y,x-y+z,x+2y+w}]]

Eval[Q_,v_,w_]:=Expand[Q v w/2]//. {(Subscript[η, i_])(Subscript[y, i_]):>1,(Subscript[η, i_]^2)(Subscript[y, i_]^2):>2}/.(Subscript[(η|y), _])->0;
Eval[ϕ_,v_]:=Expand[ϕ v]/.(Subscript[η, i_])(Subscript[y, j_]):>If[i==j,1,0];

Eval[u (Subscript[η, 1]^2)+v (Subscript[η, 1])(Subscript[η, 2]),(Subscript[y, 1])+(Subscript[y, 2]),(Subscript[y, 1])+(Subscript[y, 2])]

Pivot[v_Plus]:=v[[1]]; Pivot[v_]:=v;
(Subscript[y, i_]^( * )):=(Subscript[η, i]); (Subscript[η, i_]^( * )):=(Subscript[y, i]); (SuperStar[(vs_List)]):=Table[(SuperStar[v]),{v,vs}];

CF[PQ[vs_,gens_,Q_]]:=Module[{cvs,cgens},
{cvs,cgens}=List@@CF[Subspace[vs,gens]];
PQ[cvs,cgens,Sum[Eval[Q,v,w](SuperStar[Pivot[v]])(SuperStar[Pivot[w]]),{v,cgens},{w,cgens}]]
]

CF[PQ[{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])},{(Subscript[y, 1])+2(Subscript[y, 3]),(Subscript[y, 2])+3(Subscript[y, 3])},(Subscript[η, 3]^2)]]

Eval[(Subscript[η, 3]^2), (Subscript[y, 1])+2(Subscript[y, 3]),(Subscript[y, 2])+3(Subscript[y, 3])]

Eval[4 (Subscript[η, 1]^2)+12 (Subscript[η, 1]) (Subscript[η, 2])+9 (Subscript[η, 2]^2), (Subscript[y, 1])+2(Subscript[y, 3]),(Subscript[y, 2])+3(Subscript[y, 3])]

Eval[4 (Subscript[η, 1]^2)+12 (Subscript[η, 1]) (Subscript[η, 2])+9 (Subscript[η, 2]^2), (Subscript[y, 1]),(Subscript[y, 2])]

Eval[12 (Subscript[η, 1]) (Subscript[η, 2]), (Subscript[y, 1]),(Subscript[y, 2])]

Perp[Subspace[vs_,gens_]]:=Module[{pp},
pp=(SuperStar[Complement[vs,Pivot/@gens]]);
CF@Subspace[(SuperStar[vs]),
Table[p-Sum[Coefficient[g,(SuperStar[p])](SuperStar[Pivot[g]]),{g,gens}],{p,pp}]
]
]

Perp@Subspace[{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])},{(Subscript[y, 1])-(Subscript[y, 2])}]

Perp@Perp@Subspace[{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])},{(Subscript[y, 1])-(Subscript[y, 2])}]

(SuperStar[LT[dom_,ran_,rs_]])[Subspace[ran_,gens_]]:= Perp@CF@Subspace[(SuperStar[dom]),Table[
Sum[Eval[p,v/.rs](SuperStar[v]),{v,dom}],
{p,Perp[Subspace[ran,gens]][[2]]}
]]

(SuperStar[LT[{(Subscript[y, -1]),(Subscript[y, -2]),(Subscript[y, -3])},{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])},{(Subscript[y, -1])->(Subscript[y, 1])+2(Subscript[y, 3]),(Subscript[y, -2])->2(Subscript[y, 2])-(Subscript[y, 3]),(Subscript[y, -3])->(Subscript[y, 3])}]])[Subspace[{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])},{(Subscript[y, 1])-(Subscript[y, 2])} ]]

(SuperStar[LT[dom_,ran_,rs_]])[PQ[ran_,gens_,Q_]]:=