$RecursionLimit=65536

CDP6=CDP[4, 6, 8, 1, 10, 2, 11, 3, 12, 5, 7, 9]

Descent[perm_List]:=Count[Apply[Greater,Partition[perm,2,1],{1}],True]

CD2CDP[cd_CD] := Profile[CD2CDP,Module[
  {m=Length[cd]/2,i,beg,end},
  beg=Table[Position[cd,i],{i,1,m}];
  end=Reverse /@ beg;
  CDP @@ (Range[2m] /. Thread[Rule[Flatten[beg],Flatten[end]]])
]]

Adams[n_][cd_CD] := Adams[n][CD2CDP[cd]]
Adams[_][CDP[]]=CDP[]
Adams[n_][cdp_CDP] := Module[
  {sigma,m,i,j,ran,avail,k,t},
  m=Length[cdp]/2;
  ran=Range[2m-1];
  Sum[
    avail=ran; j=i; sigma={};
    Do[
      t=Mod[j,k]; j=(j-t)/k; ++t;
      AppendTo[sigma,avail[[t]]];
      avail=Delete[avail,t],
      {k,2m-1,1,-1}
    ];
    n*Binomial[n+2m-Descent[sigma]-2,2m-1]*
      ((cdp[[sigma~Join~{2m}]]) /. Thread[Rule[sigma,ran]]),
  {i,0,(2m-1)!-1}]
]

WSL[_][0]=0
WSL[N_][x_+y_]:=WSL[N][x]+WSL[N][y]
WSL[N_][x_ y_]:=WSL[N][x] WSL[N][y]
WSL[N_][cd_CD]:=WSL[N][CD2CDP[cd]]
WSL[N_][CDP[]]:=N
WSL[N_][cdp_CDP] := (WSL[N][cdp] = Profile[WSL,Module[
  {m,chords,delta,delpol,CL},
Print["Computing WSL[",N,"][",cdp,"]..."];
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  delpol=Expand[Times @@ (chords /.
    {i_,j_} :> (delta[i-1,j]delta[j-1,i]-delta[i-1,i]delta[j-1,j]/N))
  ];
  delpol //. {
    delta[0,2m] -> N,
    delta[i_,i_] -> N,
    delta[i_,j_]delta[j_,k_] :> delta[i,k]
  }
]])
WSL[_][x_]:=x

Casimir[W_] := Simplify[W[CDP[2,1]]/W[CDP[]]]

DeFrame[_][0]=0
DeFrame[W_][x_+y_]:=DeFrame[W][x]+DeFrame[W][y]
DeFrame[W_][c_?NumberQ*x_]:=c*DeFrame[W][x]

DeFrame[W_][cd_CD] := DeFrame[W][CD2CDP[cd]]*h^(Length[cd]/2)
DeFrame[W_][cdp_CDP] := Profile[DeFrame,Module[
  {cas=Casimir[W],m=Length[cdp]/2,sieve,nk,keep,chords,k,rcdp},
  Sum[
    sieve=Drop[IntegerDigits[k,2],1];
    nk=Plus @@ sieve;
    chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
    keep=Sort[Flatten[Table[
      If[sieve[[i]]==1,chords[[i]],{}],
      {i,1,m}
    ]]];
    rcdp=(cdp[[keep]] /. Thread[Rule[keep,Range[2 nk]]]);
    Expand[(-cas)^(m-nk)*W[rcdp]],
    {k,2^m,2*2^m-1}
  ]
]]

(* 
WSL2[n_][cd_CD] := WSL2[CD2CDP[cd]]
WSL2[n_][CDP[]]:=n+1
WSL2[n_][cdp_CDP] := (WSL2[n][cdp] = Profile[WSL2,Module[
  {i,ToB,x,y},
  ToB[0]=0;
  ToB[x_+y_]:=ToB[x]+ToB[y];
  ToB[c_ i^k_] := c * 2^k * (BernoulliB[k+1,n/2+1]-BernoulliB[k+1,1]) / (k+1);
  ToB[c_] := c*n/2;
  Expand[ToB[Expand[WSL[2][Adams[i][cdp]]]]]
]])
*)

WSL2Naive[n_][cd_CD] := WSL2Naive[CD2CDP[cd]]
WSL2Naive[n_][cdp_CDP] := (WSL2Naive[n][cdp] = Profile[WSL2Naive,Module[
  {chords,ran,m,t,tk,k,i,c},
Print["Computing WSL2Naive[",n,"][",cdp,"]..."];
  m=Length[cdp]/2;
  ran=Range[2m];
  k=0;
  chords=Flatten[Union[Sort /@ Transpose[{ran,List @@ cdp}]]];
  Sum[
    t=Drop[IntegerDigits[tk,3],1];
    c=(1/2)^Count[t,1]*(n+1);
    t=Flatten[Thread[{t,2-t}]];
    t=Thread[Rule[chords,t]];
    t=(cdp /. t);
    Do[c *= Switch[t[[i]],
        0, k--,
        1, 2k-n,
        2, n-(k++)],
      {i,1,2m}
    ];
    Expand[c],
    {tk,3^m,2*3^m-1}
  ]
]])

UFSL2Naive[n_][cd_CD] := UFSL2Naive[n][CD2CDP[cd]]
UFSL2Naive[n_][cdp_CDP] := (UFSL2Naive[n][cdp] = (
Print["Computing UFSL2Naive[",n,"][",cdp,"]..."];
  DeFrame[WSL2Naive[n]][cdp])
)

J[cd_CD] := J[CD2CDP[cd]]
J[cdp_CDP] := (J[cdp] = Profile[J,Module[
  {m=Length[cdp]/2},
Print["Computing J[",cdp,"]..."];
  Coefficient[UFSL2Naive[n][cdp],n,m+1]
]])

WConway[cd_CD] := WConway[CD2CDP[cd]]
WConway[CDP[]]=1
WConway[cdp_CDP] := (WConway[cdp] = Profile[WConway,Module[
  {m,chords,delta,delpol,CL,N},
Print["Computing WConway[",cdp,"]..."];
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  delpol=Expand[Times @@ (chords /.
    {i_,j_} :> delta[i-1,j]delta[j-1,i])
  ];
  Coefficient[delpol //. {
    delta[0,2m] -> N,
    delta[i_,i_] -> N,
    delta[i_,j_]delta[j_,k_] :> delta[i,k]
  },N]
]])

Conway[z_][x_Plus] := Conway[z] /@ x
Conway[z_][c_?NumberQ] := c
Conway[z_][c_?NumberQ*x_] := c Conway[z][x]
Conway[z_][cd_CD] := WConway[cd]*z^(Length[cd]/2)

WProduct[W0_,W1_][cd_CD] := WProduct[W0,W1][CD2CDP[cd]]
WProduct[W0_,W1_][cdp_CDP] := Profile[WProduct,Module[
  {m=Length[cdp]/2,sieve,m0,m1,chords0,chords1,chords,k,cdp0,cdp1,w0},
  Sum[
    sieve=Drop[IntegerDigits[k,2],1];
    m1=Plus @@ sieve; m0=m-m1;
    chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
    chords0=chords1={};
    Do[
      If[sieve[[i]]==0,
        AppendTo[chords0,chords[[i]]],
        AppendTo[chords1,chords[[i]]]
      ],
      {i,1,m}
    ];
    chords0=Sort[Flatten[chords0]];
    chords1=Sort[Flatten[chords1]];
    cdp0=(cdp[[chords0]] /. Thread[Rule[chords0,Range[2 m0]]]);
    cdp1=(cdp[[chords1]] /. Thread[Rule[chords1,Range[2 m1]]]);
    If[!(0===(w0=W0[cdp0])),w0*W1[cdp1],0],
    {k,2^m,2*2^m-1}
  ]
]]

IntersectionGraph[cd_CD] := IntersectionGraph[CD2CDP[cd]]
IntersectionGraph[cdp_CDP] := Profile[IntersectionGraph,Module[
  {chords,i,l1,r1,l,r,m},
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  CanonicalForm[
    Graph @@ Table[
      {l,r}=chords[[i]];
      V[i] @@ Select[Range[m],(
        {l1,r1}=chords[[#]];
        (l<l1<r<r1) || (l1<l<r1<r)
      )&],
      {i,1,m}
    ]
  ]
]]

IntersectionMatrix[cd_CD] := IntersectionMatrix[CD2CDP[cd]]
IntersectionMatrix[cdp_CDP] := Profile[IntersectionMatrix,Module[
  {i,j,l,r,l1,r1,m,chords},
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  Table[
    {l,r}=chords[[i]];
    Table[
      {l1,r1}=chords[[j]];
      If[(l<l1<r<r1) || (l1<l<r1<r),Sign[j-i],0],
      {j,1,m}
    ],
    {i,1,m}
  ]
]]

JInverse[cd_CD] := JInverse[IntersectionGraph[CD2CDP[cd]],{}]

JInverse[g_Graph] := JInverse[g,{}]

JInverse[g_Graph,l_List] := Profile[JInverse,Module[
  {m,ll,h},
  m=Length[l];
  h=List @@ (First /@ (Head /@ g));
  (-1)^Plus[
    Length[Union[FixedPoint[MapThread[Min,{#,#[[l]]}]&,Range[m]]]],
    Count[MapThread[Less,{h[[l]],h}],True]
  ]
]] /; Length[g]==Length[l]

JInverse[g_Graph,l_List] := Profile[JInverse,Module[
  {i,ll},
  ll=Length[l]+1;
  Sum[
    If[FreeQ[l,g[[ll,i]]],
      JInverse[g,Append[l,g[[ll,i]]]],
      0
    ],
    {i,Length[g[[ll]]]}
  ]
]]

UFSL2[n_][cd_CD] := UFSL2[n][CD2CDP[cd]]
UFSL2[n_][cdp_CDP] := Profile[UFSL2,Module[
  {m,chords,k,kp,km,e,g,i,n2},		(* n2 is n+2 *)
Print["Computing UFSL2[",cdp,"] by self-differentiations..."];
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  k[1]=0;
  Do[
    k[i+1]=k[i]+Sign[cdp[[i]]-i]e[First[First[Position[chords,i]]]],
    {i,1,2m-1}
  ];
  Expand[(n+1)*
    Select[ e[0] + e[-1] +
      Expand[Product[
        kp=k[First[chords[[g]]]];
        km=k[Last[chords[[g]]]];
        n2(1+(kp-km)/e[g]) - 2 kp km/e[g]^2 ,
        {g,1,m}
      ]],
      FreeQ[#,_e]&
    ] /. n2 -> n+2
  ]
]]

WSL2[n_][cd_CD] := WSL2[n][CD2CDP[cd]]
WSL2[n_][cdp_CDP] := Profile[WSL2,Module[
  {m,chords,k,kp,km,e,g,i,n2},		(* n2 is n+2 *)
Print["Computing WSL2[",cdp,"] by self-differentiations..."];
  m=Length[cdp]/2;
  chords=CL @@ Union[Sort /@ Transpose[{Range[2m],List @@ cdp}]];
  k[1]=0;
  Do[
    k[i+1]=k[i]+Sign[cdp[[i]]-i]e[First[First[Position[chords,i]]]],
    {i,1,2m-1}
  ];
  Expand[(n+1)*
    Select[ e[0] + e[-1] +
      Expand[Product[
        kp=k[First[chords[[g]]]];
        km=k[Last[chords[[g]]]];
        n2(n2/2+(kp-km)/e[g]) - 2 kp km/e[g]^2 ,
        {g,1,m}
      ]],
      FreeQ[#,_e]&
    ] /. n2 -> n+2
  ]
]]
