Kernel dies when trying to compute coefficients in a linear sum involving expressions like b[1,2][3,4]

Question

The following happens on 11.0.1.0: Have

fun=a[1][5,1]b[1,2][1,1]+a[1][4,1]b[1,2][1,2]+a[1][5,2]b[1,2][2,1]
   +a[1][4,2]b[1,2][2,2]+a[1][5,3]b[1,2][3,1]+a[1][4,3]b[1,2][3,2]
   +a[1][5,4]b[1,2][4,1]-a[2][1,2]b[1,2][4,1]+a[1][4,4]b[1,2][4,2]
   -a[2][2,2]b[1,2][4,2]+a[1][5,5]b[1,2][5,1]-a[2][1,1]b[1,2][5,1]
   +a[1][4,5]b[1,2][5,2]-a[2][2,1]b[1,2][5,2]+a[1][5,6]b[1,2][6,1]
   +a[1][4,6]b[1,2][6,2]+a[1][5,7]b[1,2][7,1]+a[1][4,7]b[1,2][7,2]
   +a[1][5,8]b[1,2][8,1]+a[1][4,8]b[1,2][8,2]+a[1][3,1]b[1,3][1,1]
   -a[3][1,3]b[1,3][1,1]+a[1][2,1]b[1,3][1,2]-a[3][2,3]b[1,3][1,2]
   +a[1][1,1]b[1,3][1,3]-a[3][3,3]b[1,3][1,3]+a[1][3,2]b[1,3][2,1]
   -a[3][1,2]b[1,3][2,1]+a[1][2,2]b[1,3][2,2]-a[3][2,2]b[1,3][2,2]
   +a[1][1,2]b[1,3][2,3]-a[3][3,2]b[1,3][2,3]+a[1][3,3]b[1,3][3,1]
   -a[3][1,1]b[1,3][3,1]+a[1][2,3]b[1,3][3,2]-a[3][2,1]b[1,3][3,2]
   +a[1][1,3]b[1,3][3,3]-a[3][3,1]b[1,3][3,3]+a[1][3,4]b[1,3][4,1]
   +a[1][2,4]b[1,3][4,2]+a[1][1,4]b[1,3][4,3]+a[1][3,5]b[1,3][5,1]
   +a[1][2,5]b[1,3][5,2]+a[1][1,5]b[1,3][5,3]+a[1][3,6]b[1,3][6,1]
   +a[1][2,6]b[1,3][6,2]+a[1][1,6]b[1,3][6,3]+a[1][3,7]b[1,3][7,1]
   +a[1][2,7]b[1,3][7,2]+a[1][1,7]b[1,3][7,3]+a[1][3,8]b[1,3][8,1]
   +a[1][2,8]b[1,3][8,2]+a[1][1,8]b[1,3][8,3]

Trying

vars = Select[Variables[fun], Head[Head[#]] == b &];
Union[Flatten[CoefficientList[fun, vars]]]

kills the kernel.

If I take only few first summands, the result is computed fairly quickly. When gradually adding summands, it works more and more slowly and seems to need more and more memory. It dies when about 3/4 of the summands are added.

Why? How to deal with such cases? Of course I can redenote my variables but I would prefer to work with them the way they are here.

Answer 1

Your vars is a list of 40 element, so, given your expression involves quadratic powers of some variables, CoefficientList appears to generate 40-folded list with too many elements (5566277615616, to be precise). So you run out of memory. Meanwhile, most of those elements are zeros (except 36 elements). Use CoefficientRules instead. In particular,

Last/@CoefficientRules[fun, vars]

will have the same effect as your (not working) line

Union[Flatten[CoefficientList[fun, vars]]]

PS: here is how I got the number 5566277615616:

Times @@ (1 + Max /@ Transpose[First /@ CoefficientRules[fun, vars]])

PPS: The bottom line is when you think of using CoeffficientList command, consider CoeffficientRules as a much better alternative. I myself mostly use CoeffficientList only for one-variable case.

Answer 2

It seems that CoefficientList becomes enormous in this case. I managed to obtain what I want using Table[Coefficient[fun,v],{v,vars}]