[Mathematica] Коэффициенты разложения

[sithif]

Мне нужно решить такое ДУ:

$ (\frac{\partial }{\partial x_1} + \nu \frac{\partial }{\partial x_2})g(x_1,x_2,x_3) = \frac{\partial f_1(x_1,x_2,x_3)}{\partial x_2} \frac{\partial f_2(x_1,x_2,x_3)}{\partial x_3} - \frac{\partial f_1(x_1,x_2,x_3)}{\partial x_3} \frac{\partial f_2(x_1,x_2,x_3)}{\partial x_2} $,

где $f_1,f_2$ известны и их легко представить в виде конечных двойных рядов:

$ f(x_1,x_2) = \sum_{nm}{f_{nm}(x_3)\exp(i(n x_1+m x_2))} $

Поэтому $g(x_1,x_2,x_3)$ тоже конечный двойной ряд.
Чтобы найти $g(x_1,x_2,x_3)$ нужно просуммировать по всем возможным коэффициентам.

Помогите построить алгоримт для определения ненулевых коэффициентов.

На примере поясню, что меня затрудняет. Пусть заданы $f_1,f_2$:

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

Теперь нужно найти коэффиценты разложения $f_1(nm),f_2(nm)$ и возможные значения $nm$. Для этого можно сделать так:

FourierCoefficient[f1, x1, n]
FourierCoefficient[f1, x2, m]

Получили значения $nm$ с ненулевыми коэффициентами: $n=-8,8,-9,9$ и $m=1,-1$.
Мне не ясно как автоматически вытащить значения $nm$. Если функции сложные, то все вписывать руками трудно.

Другой способ -- вытащить набор $nm$ :

f1 // TrigToExp // Expand

И для сложных функций (но с конецным представлением) этот способ быстрее.
Здесь тоже не понятно как вытащить набор $nm$ автоматически.

Аналогично некий набор чисел $nm$ нужно определить для правой части ДУ,
чтобы понять какие понять какие коэффициенты $g(x_1,x_2,x_3)$ не ноль.

Последняя проблема с поиском самих коэффициентов. Допустим что мы знаем $n=-8,8,-9,9$ и $m=1,-1$ для $f_1$ , тогда есть два способа найти коэфф. (медленный и быстрый):

ns = {8, -8, 9, -9};
ms = {1, -1};

Способ 1 (очень медленный):

Do[
 {
  f1c[n, m] = FourierCoefficient[f1, {x1, x2}, {n, m}]
  },
 {n, ns},
 {m, ms}
 ]

Способ 2:

Do[
  {
   f1C[n, m] = 
    Coefficient[f1 // TrigToExp // Expand, E^(I (n x1 + m x2))]
   },
  {n, ns},
  {m, ms}
  ];
f1 - Sum[f1C[n, m] E^(I (n x1 + m x2)), {n, ns}, {m, ms}] // Simplify

Во втором способе нужно отдельно считать коэфф. (0,0), если есть, например:

f1 = f1 + f100;
Coefficient[{f1 // TrigToExp // Expand } /. E^n_ -> x, x, 0]

Здесь я не уверен, что второй способ всегда работает правильно.
Можно ли как то проще сделать алготитм разложения?

-- Пт окт 18, 2013 10:58:54 --

Придумал, как достать набор используя FourierCoefficient:

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

set1 = FourierCoefficient[f1, x1, n][[1]];
set2 = FourierCoefficient[f1, 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 == " -> " "
    ]];

ns
ms

Do[
  f1C[n, m] = Coefficient[f1 // TrigToExp, E^(I (n x1 + m x2))],
  {n, ns},
  {m, ms}
  ];

f1 - Sum[f1C[n, m] E^(I (n x1 + m x2)), {n, ns}, {m, ms}] // Simplify

[sithif]

Ну и для второго способа :)

f1 = J^(3/2) (A1 Cos[8 x1] + B1 Cos[9 x1]) Cos[x2];
f1 = f1 // TrigToExp // Expand;

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

array /. i_ E^n_ -> n;
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]

По существу вопрос закрыт, но если кто то может предложить как сделать лучше или оптимизировать, буду рад.

[arseniiv]

Не понял, что нужно сделать, но избавиться от пар ToString и ToExpression и можно, и стоит.

В первом способе, например, всего-то и надо что сказать вместо них

#[[2]] & /@ (ns /. Or -> List // Flatten)

Наверно, есть и улучшения того, что до этого.

-- Пт окт 18, 2013 18:46:01 --

Далее, вместо горожения такого ужаса:

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

можно было просто написать

array = List @@ f1

-- Пт окт 18, 2013 18:56:40 --

Кстати, одинокая строка

array /. i_ E^n_ -> n;

ничего не делает. То есть, делает, но ничто от этого не меняется. Вы бы присваивали это array, что ли. Тогда дальше замена строкоманипуляций такая:

array /. Complex[0, n_] x1 + Complex[0, m_] x2 -> {n, m} // Transpose

Получится список, первый элемент которого — nы, а второй — mы.

[sithif]

Спасибо, arseniiv!
То что нужно.