Main goal of attached code is to expand expression multipliedEq[N,h,t] which is generated using parameters N = wkbrzad and h = 2 * wkbrzad - 2 and subsequently collect expression by t in the most efficient way possible. Below, I include the part of my code which allows to generate the formula of multipliedEq[N,h,t]:
dim = 6;
j = 0;
l = 1;
f[r_] := 1 - r^(3 - dim);
Q[r_] := ω^2 - f[r] * ((l * (l + dim - 3)) / r^2 + ((dim - 2) * (dim - 4)) / (4 * r^2) + ((1 - j^2) * (dim - 2)^2) / (4 * r^(dim - 1)));
V[r_] = -Q[r];
QntaPochodna[r_, n_Integer] := QntaPochodna[r, n] = If[n == 0, Q[r], f[r] * D[Expand[QntaPochodna[r, n - 1]], r]];
pierwszapochodna[r_] = QntaPochodna[r, 1] // Expand;
aa = Rationalize[Solve[pierwszapochodna[r] == 0, r, Reals] // N,0];
peak = Last[aa][[1]];
drugapochodna = (QntaPochodna[r, 2] // Simplify) /. peak;
k = (1 / 2) * drugapochodna;
s[n_, r_] :=(2 * QntaPochodna[r, n]) / (n! * drugapochodna)
ss[n_, r_] := (1 / 4) * s[n, r] * (4 * k)^((2 - n) / 4) * Exp[n * I * Pi / 4]
QQ[N_,t_]=\[Nu]+(1/2)-(1/4)*t^2+I*Sum[e^((2*n-1)/2)*ss[2*n+1,r]*t^(2*n+1)+e^n*(ss[2*n+2,r]*t^(2*n+2)-I*\[CapitalLambda][n+1]),{n,1,N-1}];
A[n_,t_]:=Sum[a[n,2*j]*t^(n+1-2*j),{j,0,Min[n, Floor[(n+1)/2]]}]
g[h_,t_]:=t+Sum[e^(n/2)*A[n,t],{n,1,h}]
\[Nu] = 1;
lele[N_, h_, t_] = (Inactivate[(D[g[h, t], {t, 3}])]/(2*Inactivate[(D[g[h, t], t])]) -
(3/4)*(Inactivate[D[g[h, t], {t, 2}]]/Inactivate[D[g[h, t], t]])^2 +
((1/2) + \[Nu] - ((Inactivate[g[h, t]])^2/4))*(Inactivate[D[g[h, t], t]])^2 -
QQ[N, t]);
multipliedEq[N_,h_,t_] = Map[
#*Inactivate[D[g[h, t], t]]^2 &,
List @@ lele[N,h,t]
];
multipliedEq[N_,h_,t_] = Activate[multipliedEq[N,h,t]//Total]//Simplify;
Next step is to generate a full equation for parameters N and h which are explicitly related to wkbrzad value:
wkbrzad=6;
maxOrder=2*wkbrzad - 2;
multipliedEq2=multipliedEq[N, h, t]/. h -> 2*wkbrzad - 2 /. N -> wkbrzad /. peak /. \[CapitalLambda][c_] -> a[2*c - 2, 2*c];
And here goes my procedure which expands and collects the multipliedEq[N,h,t] by t:
customProcess[equation_, e_, maxOrder_] :=
Module[{expandedEquation, truncatedEquation},
expandedEquation = Normal[Series[equation, {e, 0, maxOrder/2}]];
truncatedEquation =
Collect[expandedEquation /. e^n_ /; n > maxOrder/2 :> 0, e];
truncatedEquation
];
praw1 = a_*e^_. -> a;
ewspolczynniki = Collect[List @@ customProcess[multipliedEq2, e, maxOrder] /. praw1, t];
Unfortunately, the higher value of wkbrzad is (e.g. wkbrzad = 100), the more time customProcess consumes to expand and collect. This is expected since a higher value of wkbrzad generates more terms to collect. However, there might be someone with a more sophisticated approach to handle such expansion and collection problems efficiently.
I tried to apply idea from here, but it was not fast enough:
customProcess[equation_, e_, maxOrder_] :=
Module[{expandedEquation, truncatedEquation},
expandedEquation = ParallelMap[Series[#, {x, 0, maxOrder/2}] &, equation, Method -> "ItemsPerEvaluation" -> 15];
truncatedEquation =
Collect[expandedEquation /. e^n_ /; n > maxOrder/2 :> 0, e];
truncatedEquation
];