For rank n, height l, the standard (Subscript[J, l,n])-module (Subscript[Δ, p,λ]) with p propagating lines, and partition λ of (Subscript[p, l]):=min(p,l+2), has a basis which can be described by a collection (n-p)/2 “cups” (i.e. order two subsets of {1,...,n}), such that the (class of) half-diagram it describes has height ≤l, and a basis element of the Specht module (S^λ) which can be written as σ· (Subscript[e, λ]) for some permutation σ in Sym((Subscript[p, l])). Thus we record such basis elements by a pair:
{Cups , Perm}, where Cups is a list of “cups”, and Perm is a permutation (described as a permutation list). The function PermCalc[n,L,U] computes the permutation σ in Sym((Subscript[p, l])), and the integer d (the number of internal components), such that (SuperStar[U])·L=(δ^d)(Subscript[e, λ])·σ·(Subscript[e, λ])=⟨U,L⟩(Subscript[e, λ]). Thus to compute the form ⟨U,L⟩, we need only determine the scalar (Subscript[A, σ]), such that (Subscript[e, λ])·σ·(Subscript[e, λ])=(Subscript[A, σ])(Subscript[e, λ]).

PermCalc[n_,L_,U_]:=Module[{Lcups,Ucups,Lperm,Uperm,l,a,b,c,d,lP,uP,lE,lcE,uE,ucE,mE,f,G,PP},
Lcups=L[[1]];
l=n-Length[Lcups]*2;
Lperm[i_]:=Permute[Range[l],InversePermutation[L[[2]]]][[i]];
Ucups=U[[1]];
Uperm[i_]:=Permute[Range[l],InversePermutation[U[[2]]]][[i]];
a[i_]:=i;
b[i_]:=i+l;
c[i_]:=i+l+n;
d[i_]:=i+l+2*n;
lP=Complement[Range[n],Flatten[Lcups]];
uP=Complement[Range[n],Flatten[Ucups]];
lE=Table[a[i]\[UndirectedEdge]b[lP[[Lperm[i]]]],{i,1,l}];
lcE=Function[u,b[u[[1]]]\[UndirectedEdge]b[u[[2]]]]/@Lcups;
uE=Table[d[Uperm[i]]\[UndirectedEdge]c[uP[[i]]],{i,1,l}];
ucE=Function[u,c[u[[1]]]\[UndirectedEdge]c[u[[2]]]]/@Ucups;
mE=Table[b[i]\[UndirectedEdge]c[i],{i,1,n}];
G=Graph[Union[lE,lcE,uE,ucE,mE]];
PP[i_]:=
If[i==0,
Length[ConnectedComponents[G]]-Length[ConnectedComponents[G,Union[Range[l],d/@Range[l]]]],
HeavisideTheta[Min[Max/@ConnectedComponents[G,Range[l]]]-(2*n+l)-0.5]*(Max[ConnectedComponents[G,{i}]]-(2*n+l))];
PP]

The following two functions, determine the height of a configuration of cups, when there is 1 cup (“Ht1”) and 2 cups (“Ht2”) respectively.

Ht1[{P_}]:=Module[{a,b,Ht},
a=Min[P]-1;
b=Max[P]-a-2;
Ht=-1+Sign[b]*(a+b);
Ht]

Type[{P1_,P2_}]:=(1-Sign[(Min[P1]-Min[P2])*(Max[P1]-Max[P2])])/2+(1-Sign[(Min[P2]-Max[P1])*(Max[P2]-Max[P1])])

Ht2[{P1_,P2_}]:=Module[{a,b,c,d,P,T,Ht},
P=Union[P1,P2];
T=Type[{P1,P2}];
a=P[[1]]-1;
b=P[[2]]-P[[1]]-1;
c=P[[3]]-P[[2]]-1;
d=P[[4]]-P[[3]]-1;
Ht=(T-1)*(T-2)/2*(-1+Sign[b+d]*(a+b+Sign[d]*c+d))-T*(T-2)*(
-1+Sign[b+c+d]*(a+b+c+Sign[c]*(1-Sign[d])+d))+T*(T-1)/2*(
a+b+c+d-Sign[d]);
Ht]

We now give two functions below, whose input is a rank n, and a list of cups, and computes the gram-matrix of the K-module⊂(Subscript[(Subscript[Δ, p,λ]), 
]) spanned by the corresponding cup diagrams, where λ is the row, column, 21, 22, and 31 partition respectively.

GramRow[n_,Cups_,δ_]:=Module[{p,d,GM,P0,P},
p=n-2*Length[Cups[[1]]];
d=Length[Cups];
P0=Array[PermCalc[n,{Cups[[#1]],Range[p]},{Cups[[#2]],Range[p]}][0]&,{d,d}];
P=Array[Signature[PermCalc[n,{Cups[[#1]],Range[p]},{Cups[[#2]],Range[p]}]/@Range[p]]&,{d,d}];
GM=Array[δ^(P0[[#1,#2]])*(P[[#1,#2]]^2)&,{d,d}];
GM]

GramCol[n_,Cups_,δ_]:=Module[{p,d,GM,P0,P},
p=n-2*Length[Cups[[1]]];
d=Length[Cups];
P0=Array[PermCalc[n,{Cups[[#1]],Range[p]},{Cups[[#2]],Range[p]}][0]&,{d,d}];
P=Array[Signature[PermCalc[n,{Cups[[#1]],Range[p]},{Cups[[#2]],Range[p]}]/@Range[p]]&,{d,d}];
GM=Array[δ^(P0[[#1,#2]])*(P[[#1,#2]])&,{d,d}];
GM
]

Gram21[n_,Cups_,δ_]:=Module[{B,p,d,GM,P0,P},
p=n-2*Length[Cups[[1]]];
B=Join[{#,Range[p]}&/@Cups,{#,(If[#==2,3,If[#==3,2,#]]&)/@Range[p]}&/@Cups];
d=2*Length[Cups];
GM=Array[δ^(PermCalc[n,B[[#1]],B[[#2]]][0])*Sign[PermCalc[n,B[[#1]],B[[#2]]][3]]*
(1+3/2*Sign[PermCalc[n,B[[#1]],B[[#2]]][3]-3])&,{d,d}];
GM]


Gram22[n_,Cups_,δ_]:=Module[{B,p,d,GM,P0,P},
p=n-2*Length[Cups[[1]]];
B=Join[{#,Range[p]}&/@Cups,{#,(If[#==2,3,If[#==3,2,#]]&)/@Range[p]}&/@Cups];
d=2*Length[Cups];
GM=Array[δ^(PermCalc[n,B[[#1]],B[[#2]]][0])*Sign[PermCalc[n,B[[#1]],B[[#2]]][4]]*
If[MemberQ[{{1,2,3,4},{2,1,3,4},{1,2,4,3},{2,1,4,3},{3,4,1,2},{3,4,2,1},{4,3,1,2},{4,3,2,1}},
PermCalc[n,B[[#1]],B[[#2]]]/@{1,2,3,4}],
1,
-1/2]&,{d,d}];
GM]

Gram31[n_,Cups_,δ_]:=Module[{B,p,d,GM,P0,P},
p=n-2*Length[Cups[[1]]];
B=Join[{#,Range[p]}&/@Cups,{#,(If[#==2,4,If[#==4,2,#]]&)/@Range[p]}&/@Cups,{#,(If[#==3,4,If[#==4,3,#]]&)/@Range[p]}&/@Cups];
d=3*Length[Cups];
GM=Array[δ^(PermCalc[n,B[[#1]],B[[#2]]][0])*Sign[PermCalc[n,B[[#1]],B[[#2]]][4]]*
(1+(1+1/3)*Sign[PermCalc[n,B[[#1]],B[[#2]]][4]-4])&,{d,d}];
GM]

Below we write functions to compute all 1 and 2 cup configurations of rank n, and height at most l.

Cups1[n_,l_]:=Module[{S,SS,SSS},
S=Subsets[Range[n],{2}];
SS={#}&/@S;
SSS=Select[SS,Ht1[#]<=l&];
SSS]

Cups2[n_,l_]:=Module[{S,SS,SSS},
S=Subsets[Range[n],{4}];
SS=Join[{{#[[1]],#[[2]]},{#[[3]],#[[4]]}}&/@S,{{#[[1]],#[[3]]},{#[[2]],#[[4]]}}&/@S,{{#[[1]],#[[4]]},{#[[3]],#[[2]]}}&/@S];
SSS=Select[SS,Ht2[#]<=l&];
SSS]

Using the above functions, we compute below the gram matrices of the (Subscript[J, l,n]) standard modules (Subscript[Δ, n-2,λ]) and (Subscript[Δ, n-4,λ]) (who have bases described by 1 and 2 cup configurations of rank n,height ≤ l respectively), where λ is the appropriate row/column partition.

GRRow1[n_,l_,δ_]:=GramRow[n,Cups1[n,l],δ]
GRCol1[n_,l_,δ_]:=GramCol[n,Cups1[n,l],δ]
GRRow2[n_,l_,δ_]:=GramRow[n,Cups2[n,l],δ]
GRCol2[n_,l_,δ_]:=GramCol[n,Cups2[n,l],δ]