Sow only if different from zero

Question

I am trying to collect elements with Reap and Sow, where I am interested only in non-zero elements, that is I am trying something like that

Flatten@Last@Reap@Do[
        Sow[Cases[{preThreeJSymbols[l1,m1,l2,m2,k]},Except[0]]],
        {l1,0,3},{m1,-3,3},{l2,0,3},{m2,-3,3},{k,0,6}]

where preThreeJSymbols is given by

preThreeJSymbols[l1_, m1_, l2_, m2_, k_] := 
 If[Abs[l1 - l2] <= k <= l1 + l2 && 
    Abs[m1 - m2] <= k && Abs[m1] <= l1 && 
    Abs[m2] <= l2,
    ThreeJSymbol[{l1, 0.}, {k, 0.}, {l2, 0.}]*
    ThreeJSymbol[{l1, -m1}, {k, m1 - m2}, {l2, m2}], 0]

I have two issues here:

First, is this the most efficient/natural way of doing it in Mathematica, I have the feeling that there will be a solution with pure functions (some condition/pattern matching?) Secondly, in my case preThreeJSymbols[l1,m1,l2,m2,k] seems to return both 0 and 0.. (I don't know why - I am confused here), which are interpreted differently by Except[], hence not all zeroes are discarded.

Probably, I have to add that I do not want to use Table/ParallelTable, as in my application the ranges of l1, m1, l2, m2 and k are much larger and the resulting table has more than 100 million elements, which makes it too big for my RAM to store. However, I know that most of the elements will be zero (around 5-6% are non-zero), so I want to go over all the elements and pick only the non-vanishing ones without actually generating a massive table.

Late Update

Created a new question as per a suggestion

I have implemented Mr. Wizard's solution as

precomputeThreeJTable[Lmax_] := (Clear[precomputedSymbols]; 
precomputedSymbols = 
Reap[Do[preThreeJSymbols[l1, m1, l2, m2, k] // 
   If[# != 0, 
     Sow[{pairFunction[pairFunction[l1 + 1, m1 + Lmax + 1], 
        pairFunction[l2 + 1, pairFunction[m2 + Lmax + 1, k + 1]]],
        N[#]}]] &,
   {l1, 0, Lmax}, {m1, -Lmax, Lmax}, {l2, 0, Lmax}, {m2, Lmax, Lmax},
   {k, 0, 2 Lmax}]][[2, 1]]; 
threeJTable = 
AssociationThread[precomputedSymbols[[All, 1]], precomputedSymbols[[All, 2]]]; 
Export[StringInsert["somewhere", ToString[Lmax], -6], threeJTable, "WDX"];)

where preThreeJSymbols is as above and pairFunction is given by

pairFunction[x_, y_] := ((x + y) (x + y + 1))/2 + y

And I want to do this for Lmax around 45. At the moment I can manage only 30 - the reason being that Mathematica eats all my RAM. I have noticed that when I run precomputeThreeJTable, at the end of the calculation (when the Association is being created I assume) there is a massive spike in RAM usage, but after the command is evaluated the spike is gone and I can go on using threeJTable in other calculations with far less RAM being taken. This spike in RAM usage is also seen when I Import the exported file (the file is around 200mb). For Lmax=35 my laptop can't take the memory spike. My question is whether it is possible to avoid this somehow - maybe create (and later Import) the Association in pieces or something else? I also tried using a SparseArray instead, replacing the AssociationThread code by

SparseArray[Table[precomputedSymbols[[i, 1]] -> precomputedSymbols[[i, 2]],
           {i, 1, Length[precomputedSymbols]}]]

The spkie is still there. Not only that but another problem comes up, due to pairFunction's nature - it creates very huge integers pretty easily, which means that the dimension of the SparseArray will be enormous, so when I try using it in a calculation, even for Lmax=3, my Mathematica just resets (that is - clears all definitions - like when it runs out of memory). I can show the code for the way it is used, though it is a bit long. Is this expected behaviour or I am probably doing something wrong.

Thank you

Answer 1

Inexact zeros

preThreeJSymbols[l1,m1,l2,m2,k] seems to return both 0 and 0.

You introduced inexact arithmatic in the expression:

ThreeJSymbol[{l1, 0.}, {k, 0.}, {l2, 0.}]

You can either add Chop to your result or make these zeros exact:

ThreeJSymbol[{l1, 0}, {k, 0}, {l2, 0}]

However if you use expr != 0 as Pickett recommended you do not need either.

Cases

You are using Cases on an expression with only one element when it is ostensibly intended to be used on lists of elements therefore other methods are likely to be faster. Your use also results in sowing an empty list {} for every zero which actually takes more RAM:

ByteCount[0]
ByteCount[{}]

16

40

Try this instead:

Reap[Do[
  preThreeJSymbols[l1, m1, l2, m2, k] // If[# != 0, Sow[#]] &,
  {l1, 0, 3}, {m1, -3, 3}, {l2, 0, 3}, {m2, -3, 3}, {k, 0, 6}
]][[2, 1]]

Possible optimization

It seems that ThreeJSymbol is defined in top-level Mathematica code. You may read its definition in version 10.1 with:

Needs["GeneralUtilities`"]

PrintDefinitions @ ThreeJSymbol

(See What is the most convenient way to read definitions of in-memory symbols when we don't have the source files? (Spelunking tools) for other versions.)

If you can vectorize this code you may be able produce a significant performance improvement.