More efficient implementation for comparing coefficient lists in a Do-loop

Question

I'm wondering how to speed up the following code so it actually computes for $n=2$:

f[n_] := Expand[Sum[FunctionExpand[QBinomial[n, j, q]]*q^(j^2), {j, 0, n}]]

lhs[n_] := Sum[(-1)^j*q^(j(5j + 1)/2), {j, -n, n}]

rhs3[a_, b_, c_, d_, e_, g_, h_] := 
  Expand[q^a - f[1]*q^b*Product[1 - q^i, {i, c, d}] + f[2]*q^e*Product[1 - q^i, {i, g, h}]]

B[n_] := 
  Do[
    If[CoefficientList[lhs[n], q] == CoefficientList[rhs3[a_, b_, c_, d_, e_, g_, h_], q], 
      Print[{a,b,c,d,e,g,h}]], 
    {a, 0, 15}, {b, 0, 15}, {c, 1, 5}, {d, 1, 5}, {e, 0,15}, {g, 1, 5}, {h, 1, 5}]

A Do loop with this many iterators may be too much computing, but there must be some built-in constructs which allow for an effective implementation.

Sample input would be B[2]. Sample output would be {11,1,1,1,1,2,3} (which is actually one possible solution. However, the point is to print all possible solutions, so the actual output would be a number of such lists.)

Edit:

I want to emphasize that I would like to see an approach that will work for more complicated functions for rhs3[a_, ...] that involve a few more iterator variables. To be specific, I would like to execute the comparison at least somewhat quickly for the following RHS with $n=3$ (and I'll label it as rhs3):

rhs3[a_, b_, c_, d_, e_, g_, h_, j_, k_, l_, x_, r_, y_] := 
  Expand[-f[3*x + y]*q^a + f[3*x + r + y]*q^b*Product[1 - q^i, {i, c, d}] 
    - f[3*x + 2*r + y]*q^e*Product[1 - q^i, {i, g, h}]] 
      + f[3*x + 3*r + y]*q^j*Product[1 - q^i, {i, k, l}]]

with the following variable ranges: {a, 0, 30}, {b, 0, 25}, {c, 1, 7}, {d, c, 7}, {e, 0, 20}, {g, 1, 7}, {h, g, 7}, {j, 0, 15}, {k, 1, 7}, {l, k, 7}, {x, 0, 5}, {r, -5, 5}, {y, -5, 5}. This is of course asking for a lot, but I want to state the nature of the problem in full generality for future visitors.

Answer 1

You had the right idea..: work with a specific q:

 rhs32[a_, b_, c_, d_, e_, g_, h_] := 
        With[{q = 2}, 
            Expand[q^a - f[1]*q^b*Product[1 - q^i, {i, c, d}] + 
             f[2]*q^e*Product[1 - q^i, {i, g, h}]]]

 (list = Flatten[
        Table[{{a, b, c, d, e, g, h}, rhs32[a, b, c, d, e, g, h]}, {a, 0,15},
           {b, 0, 15}, {c, 1, 5}, {d, c, 5}, {e, 0, 15},
           {g, 1, 5}, {h, g, 5}], 6]) // AbsoluteTiming // First

352.067372 ( 6 minutes )

Now find possible matches to lhs'[n]

  pmatch = Select[list, #[[2]] == (lhs[2] /. q -> 2) & ]

{{{3, 1, 1, 3, 0, 3, 4}, 2549},
   {{7, 1, 1, 1, 0, 3, 4}, 2549},
   {{9, 0, 3, 5, 4, 1, 3}, 2549},
   {{11, 1, 2, 2, 0, 2, 3},2549}}

now go back and check analytically:

 Select[ {#[[1]], CoefficientList[rhs3 @@ #[[1]], q]} & /@ 
       pmatch , #[[2]] === CoefficientList[lhs[2], q] &]

{{{11, 1, 2, 2, 0, 2, 3}, {1, 0, -1, -1, 0, 0, 0, 0, 0, 1, 0, 1}}}

Answer 2

As you suggested and @george2079 showed, using a specific value of q can help avoid the slowness of CoefficientList by eliminating many cases. Compiling can speed up the process more -- well, a lot more on a 4(8)-core i7.

Here params represents {a, b, c, d, e, g, h}. The values to iterate through are stored in iter. We use Pick to pick out the one(s) for which equality holds. The coefficients can be checked

Clear[bC];

bC = With[{f1 = f[1], f2 = f[2], lhs2 = lhs[2], prod0 = 1 - q^# & /@ Range[5]},
   Compile[{{q, _Integer}, {params, _Integer, 1}},
    Module[{prod = prod0},
     If[params[[3]] > params[[4]] || params[[6]] > params[[7]],
      1,                              (* nonzero for out-of-order parameters *)
      q^params[[1]] -                 (* rhs - lhs *)
       Fold[#1*#2 &, f1*q^params[[2]], 
        prod[[ params[[3]] ;; params[[4]] ]] ] + 
       Fold[#1*#2 &, f2*q^params[[5]], 
        prod[[ params[[6]] ;; params[[7]] ]] ] - lhs2]
     ],
    RuntimeAttributes -> {Listable}, Parallelization -> True]
   ];

(iter = Tuples[{Range[0, 15], Range[0, 15], Range[5], Range[5], 
     Range[0, 15], Range[5], Range[5]}];
 Pick[iter, bC[3, iter], 0]) // AbsoluteTiming
(*
  {1.415915, {{11, 1, 2, 2, 0, 2, 3}}}
*)

CoefficientList[lhs[2], q] == CoefficientList[rhs3 @@ %[[-1, 1]], q]
(*
  True
*)

[Note: The general form of Table used by @george2079 does not compile, so I used all of the tuples. Maybe there's another way to generate only the proper ones.]