Find possible sets of numbers for non-zero coefficients (optimization)

Questions
1

Hi,

I need to optimize sets search of non-zero coefficients for real functions of the form (with possibly more harmonics):

f = x3^(3/2) (A1 Cos[8 x1] + B1 Cos[9 x1] + C1 Cos[10 x1]) (Cos[x2] + Cos[3 x2]);

f is to be expanded into double Fourier series with respect to x1 and x2, i.e. f = Sum f(nm) exp(i(n x1 + m x2)).
And the values of (nm) for which f(nm)'s are non-zero should be found automaticaly.

So far I’ve found 2 ways of extracting (nm). But I’m not sure that they are bug-free and they indeed not optimized.

Method 1:

f = x3^(3/2) (A1 Cos[8 x1] + B1 Cos[9 x1] + C1 Cos[10 x1]) (Cos[x2] + Cos[3 x2]);

set1 = FourierCoefficient[f, x1, n][[1]];
set2 = FourierCoefficient[f, x2, m][[1]];

l1 = Length[set1];
l2 = Length[set2];

ns = Table[set1[[i]][[2]], {i, 1, l1}];
ms = Table[set2[[i]][[2]], {i, 1, l2}];

ns = ToExpression[StringReplace[StringReplace[ToString[ns], "||" -> ","],"n == " -> " "]]
ms = ToExpression[StringReplace[StringReplace[ToString[ms], "||" -> ","],"m == " -> " "]]

Method 2:

f = x3^(3/2) (A1 Cos[8 x1] + B1 Cos[9 x1] + C1 Cos[10 x1]) (Cos[x2] + Cos[3 x2]);
f = f // TrigToExp // Expand;

array = Table[0, {i, 1, Length[f]}];
Do[{array[[i]] = f[[i]];}, {i, 1, Length[f]}];

ToString[array /. i_ E^n_ -> n];
StringReplace[% , "x1" -> ","];
StringReplace[% , "I" -> "1"];
StringReplace[% , "x2" -> "1"];
full = ToExpression[%];
ns = Take[full, {1, Length[full], 2}];
ms = Take[full, {2, Length[full], 2}];
ns = DeleteDuplicates[ns]
ms = DeleteDuplicates[ms]

Any suggestions how to optimize (mn) extraction? Or maybe is there a better way to do it?

Thanks,
I.M.

2

[It pays to post code that actually works. There is a definition mismatch between `f` and `f1`.]

f1 = x3^(3/2) (A1 Cos[8 x1] + B1 Cos[9 x1] + C1 Cos[10 x1]) (Cos[x2] +
      Cos[3 x2]);

Timing[
 fcoeffs =
   Table[FourierCoefficient[
     Table[FourierCoefficient[f1, x1, n], {n, -12, 12}], x2,
     m], {m, -12, 12}];]

Out[101]= {59.460000, Null}
3

Thanks, Daniel. I’ve fixed the typo.
The point is that function is not known and range can’t be given as the max of (nm).
Even if we can find max values for n and m, FourierCoefficient with range {n,-nmax,nmax} and {m,-mmax,mmax} is too slow.
Second method looks way faster but is need special treatment for (n,m)=(0,0). f should be modified as f-(constant part. f) first.

f = f//TrigToExp//Expand;
f=f-Coefficient[f/.E^n_->p,p,0];

Also cases when n=0 & m\=0 || n\=0 & m=0 are handled incorrectly for now.
FourierCoefficient gives right answer for all possible combinations.

4

I’ve upgraded the problem’s solution but still not happy with the result.
Here are the points that bother me:

  1. Do I use “Parallelize” correctly?

  2. When “Parallelize” is ON, coefficients are not computed, i.e. “?fc” gives nothing. Why does this happen?

  3. Double Do loop computes extra coeffs. I need (a,b) to run only through given pairs.

FindPairs::usage = "Placeholder";

FindPairs[function_, coeffs_, args_List, test_Integer: 0] := Module[
   {
    FUNCTION,
    ARGS,
    OUTPUT = {__, __},
    a, b, c, d
    },
   {
    (*Parallelize[*) (*<-- UNCOMMENT FOR PARALLEL COMPUTATION *)
    (* PAIRS *)
    ARGS = args;
    FUNCTION = Im[List @@ Expand[TrigToExp[function]] /. {a_ E^b_ -> b} 
                                                      /. {a_ ARGS[[1]] + b_ ARGS[[2]] -> {a, b}} 
                                                      /. {a_ ARGS[[1]] -> {a, 0}} 
                                                      /. {a_ ARGS[[2]] -> {0, a}}] 
                                                      /. Im[a_] -> {0, 0};
    OUTPUT[[1]] = DeleteDuplicates[Transpose[FUNCTION][[1]]];
    OUTPUT[[2]] = DeleteDuplicates[Transpose[FUNCTION][[2]]];
    (* COEFFICIENTS *)
    FUNCTION = Expand[TrigToExp[function]];
    Do[
     {
      coeffs[a, b] = Which[
           (a == 0 && b == 0), Coefficient[FUNCTION /. E^a_ -> ARGS[[1]], ARGS[[1]], 0],
           (a == 0 && (b > 0 || b < 0)), Coefficient[FUNCTION /. a_ E^(b_ + c_ ) -> 0, E^(I b ARGS[[2]])],
           ((a > 0 || a < 0) && b == 0), Coefficient[FUNCTION /. a_ E^(b_ + c_ ) -> 0, E^(I a ARGS[[1]])],
           ((a > 0 || a < 0) && (b > 0 || b < 0)), Coefficient[FUNCTION, E^(I a ARGS[[1]] + I b ARGS[[2]])]
         ];
      },
     {a, OUTPUT[[1]]},
     {b, OUTPUT[[2]]}
     ];
    OUTPUT
    (*]*) (*<-- UNCOMMENT FOR PARALLEL COMPUTATION *)
    }];

(* EXAMPLE *)
f=x3^(3/2)(A1 Cos[8 x1] + B1 Cos[9 x1] + C1 Cos[10 x1])(Cos[x2]+
Cos[3 x2])+f00+ D1 Cos[7 x1]+E1 Cos[11 x2]+F1 Cos[x1] Cos[5 x2];
range = FindPairs[f, fc, {x1, x2}][[1]]
f - Sum[fc[i, j] E^(I (i x1 + j x2)), {i, range[[1]]}, {j, range[[2]]}] // Simplify
?fc

Thanks,
I.M.