(* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% *)
(* File: polyharm.m *)
(* Created: September 12, 1991 *)
(* Revised: December 11, 1992 *)
(* *)
(* Tested with the aid of Mathematica Version 2.0 for Microsoft Windows. *)
(* ======================================================================== *)
(* *)
(* Basic Sets of Polynomial Solutions for the Iterated Laplace *)
(* and Wave Equations *)
(* *)
(* *)
(* by Alexander Urintsev *)
(* *)
(* ======================================================================== *)
(* PURPOSE: *)
(* *)
(* Function PolyHarm[m, n, x, EquationType] calculates a basic set *)
(* of polynomial solutions for the iterated Laplace or wave equation *)
(* having the form *)
(* *)
(* ___ ___ m *)
(* | k 2 | *)
(* | ____ d | *)
(* | \ _______ | u = 0 (for the iterated Laplace equation) or *)
(* | /___ 2 | *)
(* | j=1 d x | *)
(* |__ j __| *)
(* *)
(* *)
(* ___ ___ m *)
(* | k-1 2 2 | *)
(* | ____ d d | *)
(* | \ _______ _ _______ | u = 0 (for the iterated wave equation) *)
(* | /___ 2 2 | *)
(* | j=1 d x d x | *)
(* |__ j k __| *)
(* *)
(* *)
(* using the explicit formula given in the paper: *)
(* *)
(* E.P. Miles, Jr. and Ernest Wiliams, Basic sets of polynomials for the *)
(* iterated Laplace and wave equations. Duke Mathematical Journal, *)
(* 1959, Volume 26, Number 1, pp. 35-40. *)
(* *)
(* Remark 1. *)
(* du/dxj = D[u, xj] represents here a partial derivative with respect *)
(* to argument xj. ------- *)
(* *)
(* Remark 2. *)
(* About polynomial solutions of Laplace equation (harmonic polynomials) *)
(* see also: *)
(* *)
(* 1. E.P. Miles, Jr. and Ernest Wiliams, A basic set of homogeneous *)
(* harmonic polynomials in k variables. Proceedings of the American *)
(* Mathematical Society, 1955, Volume 6, Number 2, pp. 191-194. *)
(* *)
(* 2. H. Wind, Processing Magnetic Field Data. Journal of Computational *)
(* Physics, 1968, Volume 2, Number 3, pp. 274-278. *)
(* ======================================================================== *)
(* *)
(* About the Author *)
(* *)
(* Dr. Alexander Urintsev works at the Joint Institute for Nuclear *)
(* Research as a senior research associate. He is 46 years old. He has *)
(* been working in applied research for 23 years. Dr. Urintsev is the *)
(* author/coauthor of about 40 scientific publications in the field of *)
(* applied and computational mathematics, hydrodynamic stability, *)
(* self-organization in nonlinear dynamical systems, application of *)
(* computer algebra systems in the problems of nonlinear magnetic optics *)
(* and accelerator physics. *)
(* *)
(* During 11 years Dr. Urintsev has been combining research work with *)
(* teaching at the Mechanical-Mathematical Department of the University *)
(* (Department of Computational Mathematics, Department of Functions and *)
(* Functional Analysis Theory): lecturing on programming, numerical *)
(* methods, probability theory and mathematical statistics, application *)
(* of computer algebra systems in mechanics and mathematics, supervising *)
(* the students' research work, etc. *)
(* *)
(* Fields of interest: *)
(* development and application of complex computer systems such as *)
(* Mathematica, Maple, Reduce both in applied researches and in *)
(* educational purposes, working out new algorithms of symbolic and *)
(* numerical mathematics, solving differential and integral equations, *)
(* data processing, producing of the special applied software, *)
(* programming in Mathematica, Maple, Reduce, C, Lisp, Fortran, Basic. *)
(* *)
(* Dr. Urintsev wants to apply for a job abroad. He would like to get *)
(* a position in a serious research institution, governmental *)
(* organization, computer firm producing software as a researcher, *)
(* software engineer or a programmer, or as a teacher at university or *)
(* at a college. *)
(* *)
(* Dr. Urintsev would be immensely grateful to colleagues for information *)
(* about possible vacancies, any useful advice, or for kind assistance. *)
(* Necessary documents (detailed CV, list of publications, degrees *)
(* copies, letters of recommendation, application) are available for *)
(* inquiry. *)
(* *)
(* December 1992, JINR, Dubna, RUSSIA. *)
(* *)
(* *)
(* Postal address: *)
(* *)
(* Dr. Alexander Urintsev *)
(* Department of Heavy Quarks *)
(* Laboratory of Particle Physics *)
(* Joint Institute for Nuclear Research *)
(* Head Post Office, P.O. Box 79 *)
(* 101000, Moscow *)
(* RUSSIA *)
(* *)
(* Fax: (7095) 975 23 81 *)
(* Telex: 911621 DUBNA SU *)
(* *)
(* Email: urintsev@lhe24.jinr.dubna.su *)
(* *)
(* ======================================================================== *)
BeginPackage["PolyHarm`"]
PolyHarm::usage =
" PolyHarm[m, n, x, EquationType] gives the list containing\n
the basic set of polynomial solutions for the iterated\n
Laplace or wave equation. Integer number m>0 is a power\n
of Laplace equation (or wave equation) operator. Integer\n
number n is the maximum power of computing homogeneous\n
polynomials when n>0 (polynomials having powers from 0 to\n
n, including, are computed); if n<0 then homogeneous\n
polynomials of power equal to (-n) only are computed.\n
Argument x is the list of independent variables for the\n
iterated Laplace or wave differential equation.\n
The argument EquationType can have a value equal to 1 or\n
(-1) only: 1 corresponds the Laplace equation case,\n
(-1) - the wave equation one. Argument EquationType is\n
optional, by default EquationType=1."
PolyHarm::arg3 = "The third actual argument is invalid."
PolyHarm::arg4 = "The fourth actual argument must be 1 or -1."
Begin["`Private`"]
PolyHarm[m_Integer?Positive, n_Integer, x_?VectorQ, EquationType_Integer:1]:=
Module[{s, i, j, xi, lx, err},
s = {};
lx = Length[x];
err = lx < 2 || lx != Length[Union[x]];
If[err, Goto[LabM]];
i = 1;
err = False;
While[Not[err || i>lx],
xi = x[[i]];
i = i + 1;
If[NumberQ[xi] ||
Length[Variables[xi]] !=1 ||
!PolynomialQ[xi] ||
SameQ[Head[xi], Plus] ||
SameQ[Head[xi], Times] ||
SameQ[Head[xi], Power],
err = True
]
];
Label[LabM];
If[err, Message[PolyHarm::arg3]; Return[s]];
If[Abs[EquationType] != 1, Message[PolyHarm::arg4]; Return[s]];
If[n<0, s = SetPoly[m, -n, x, EquationType],
Do[AppendTo[s, SetPoly[m, j, x, EquationType]], {j, 0, n}];
s = Flatten[s]
];
s
]
SetPoly[m_, n_, x_, EquationType_] :=
Block[{k, a, akm, ae, s, t, f, i, k1, j},
k = Length[x];
akm = Min[2 m - 1, n];
ae = n - a[k];
s = {};
If[EquationType == 1,
(* then: the Laplace equation case *)
t = f[Hold[s = Append[s,
HomogeneousPolynomial[(-1)^j, m, n, x,
Table[a[i], {i, 1, k}]]]],
{a[k], 0, akm}],
(* else: the wave equation case *)
t = f[Hold[s = Append[s,
HomogeneousPolynomial[1, m, n, x, Table[a[i], {i, 1, k}]]]],
{a[k], 0, akm}]
];
k1 = k - 1;
Do[ t = Append[t, {a[j], 0, ae}];
ae = ae - a[j],
{j, k1, 2, -1}
];
a[1] = ae;
t /. {f->Do, Hold->Identity};
s
]
HomogeneousPolynomial[term_, m_, n_, x_, a_] :=
Block[{k, ak, ak2, jend, k1, t, j, p, b, i},
k = Length[a];
ak = a[[k]];
ak2 = Quotient[ak, 2];
jend = Quotient[n - ak, 2];
k1 = k - 1;
t = Product[x[[j]]^a[[j]], {j, k1}];
p = 0;
Do[ b = ak + 2 j;
p = p + term Binomial[j + ak2, ak2] t x[[k]]^b/b!;
If[j != jend, t = Sum[D[t, {x[[i]], 2}], {i, k1}]],
{j, 0, jend}
];
Numerator[Together[p]]
]
End[] (* end Private Context *)
EndPackage[] (* end PolyHarm Context *)
(* %%%%%%%%%%%%%%%%%%%%%%% The end of polyharm.m file %%%%%%%%%%%%%%%%%% *)