Message Boards Message Boards

0
|
3068 Views
|
3 Replies
|
0 Total Likes
View groups...
Share
Share this post:
GROUPS:

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

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.
POSTED BY: Ivan Morozov
3 Replies
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.
POSTED BY: Ivan Morozov
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.
POSTED BY: Ivan Morozov
[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}
POSTED BY: Daniel Lichtblau
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract