(* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% *)
(* File: smoothi.m *)
(* Created: November 6, 1991 *)
(* Revised: December 10, 1992 *)
(* *)
(* Tested with the aid of Mathematica Version 2.0 for Microsoft Windows. *)
(* ======================================================================== *)
(* *)
(* Data Smoothing with Least-Squares Method *)
(* by Polynomials of the 1st, 2nd or 3rd Power *)
(* *)
(* *)
(* by Alexander Urintsev *)
(* *)
(* ======================================================================== *)
(* PURPOSE: *)
(* *)
(* Smoothing[y, METHOD] performs smoothing of the data contained in *)
(* vector y and returns the vector of smoothed data as a result. It *)
(* is assumed that elements of list y are a values of some function *)
(* f(x) given with accidental errors at equidistant points of the *)
(* argument x. The user can select from one of the five smoothing *)
(* methods according to the value of argument METHOD. *)
(* *)
(* For references about smoothing by least-squares method see *)
(* for example : *)
(* *)
(* F.B. Hildebrand, Introduction to Numerical Analysis, Mc Graw-Hill, *)
(* New York - Toronto - London, 1956, pp. 295-302. *)
(* ======================================================================== *)
(* *)
(* 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["Smoothing`"]
Smoothing::usage =
" Smoothing[y, METHOD] performs smoothing of the data\n
contained in vector y and returns the vector of\n
smoothed data as a result. It is assumed that elements\n
of list y are a values of some function f(x) given with\n
accidental errors at equidistant points of the argument x.\n
According to the value of argument METHOD which can have\n
only the value 1, 2, 3, 4 or 5, you can select one from\n
the five ways of smoothing :\n
METHOD=1, smoothing by the 1st power polynomial\n
using 3- knot formula;\n
METHOD=2, smoothing by the 1st power polynomial\n
using 5- knot formula;\n
METHOD=3, smoothing by the 2nd power polynomial\n
using 5- knot formula;\n
METHOD=4, smoothing by the 3rd power polynomial\n
using 5- knot formula;\n
METHOD=5, smoothing by the 3rd power polynomial\n
using 7- knot formula."
Smoothing::err1 =
"If METHOD=1 then length of the 1st argument must be >= 3."
Smoothing::err2 =
"If METHOD=2,3,4 then length of the 1st argument must be >= 5."
Smoothing::err3 =
"If METHOD=5 then length of the 1st argument must be >= 7."
Begin["`Private`"]
Smoothing[y_?VectorQ, METHOD_Integer] :=
Module[{z, i, n, nm, smooth13, smooth15, smooth25, smooth35, smooth37},
n = Length[y];
If[METHOD == 1, Goto[smooth13]];
If[n<5 && METHOD<5, Message[Smoothing::err2]; Return[{}]];
If[METHOD == 2, Goto[smooth15]];
If[METHOD == 3, Goto[smooth25]];
If[METHOD == 4, Goto[smooth35]];
If[n<7, Message[Smoothing::err3]; Return[{}]];
If[METHOD == 5, Goto[smooth37]];
Label[smooth13];
If[n<3, Message[Smoothing::err1]; Return[{}]];
z = {(5 y[[1]] + 2 y[[2]] - y[[3]])/6};
nm = n - 1;
Do[ AppendTo[z, (y[[i-1]] + y[[i]] + y[[i+1]])/3], {i, 2, nm}];
AppendTo[z, (-y[[n-2]] + 2 y[[n-1]] + 5 y[[n]])/6];
Return[z];
Label[smooth15];
z = {(3 y[[1]] + 2 y[[2]] + y[[3]] - y[[5]])/5,
(4 y[[1]] + 3 y[[2]] + 2 y[[3]] + y[[4]])/10};
nm = n - 2;
Do[ AppendTo[z, (y[[i-2]] + y[[i-1]] + y[[i]] +
y[[i+1]] + y[[i+2]])/5], {i, 3, nm}];
AppendTo[z, (y[[n-3]] + 2 y[[n-2]] + 3 y[[n-1]] + 4 y[[n]])/10];
AppendTo[z, (-y[[n-4]] + y[[n-2]] + 2 y[[n-1]] + 3 y[[n]])/5];
Return[z];
Label[smooth25];
z = {31 y[[1]] + 9 y[[2]] - 3 y[[3]] - 5 y[[4]] + 3 y[[5]],
9 y[[1]] + 13 y[[2]] + 12 y[[3]] + 6 y[[4]] - 5 y[[5]]}/35;
nm = n - 2;
Do[ AppendTo[z, (12 (y[[i-1]] + y[[i+1]]) - 3 (y[[i-2]] + y[[i+2]]) +
17 y[[i]])/35], {i, 3, nm}];
AppendTo[z, (-5 y[[n-4]] + 6 y[[n-3]] + 12 y[[n-2]] +
13 y[[n-1]] + 9 y[[n]])/35];
AppendTo[z, (3 y[[n-4]] - 5 y[[n-3]] - 3 y[[n-2]] +
9 y[[n-1]] + 31 y[[n]])/35];
Return[z];
Label[smooth35];
z = {(-y[[5]] - 6 y[[3]] + 4 (y[[2]]+ y[[4]]) + 69 y[[1]])/70,
(2 (y[[1]] + y[[5]]) - 8 y[[4]] + 12 y[[3]] + 27 y[[2]])/35};
nm = n - 2;
Do[ AppendTo[z, (-3 (y[[i-2]] + y[[i+2]])+ 17 y[[i]] +
12 (y[[i-1]] + y[[i+1]]))/35],
{i, 3, nm}];
AppendTo[z, (2 (y[[n-4]] + y[[n]]) - 8 y[[n-3]] +
12 y[[n-2]] + 27 y[[n-1]])/35];
AppendTo[z, (-y[[n-4]] - 6 y[[n-2]] +
4 (y[[n-3]] + y[[n-1]]) + 69 y[[n]])/70];
Return[z];
Label[smooth37];
z = {y[[5]] - 2 y[[7]] + 4 (y[[6]] - y[[4]] - y[[3]]) +
8 y[[2]] + 39 y[[1]],
4 (y[[7]] - y[[5]]) + 6 y[[4]] - 7 y[[6]] + 8 y[[1]] +
16 y[[3]] + 19 y[[2]],
y[[7]] + 2 y[[5]] - 4 (y[[1]] + y[[6]]) + 12 y[[4]] +
16 y[[2]] + 19 y[[3]]}/42;
nm = n - 3;
Do[ AppendTo[z, (-2 (y[[i-3]] + y[[i+3]]) +
3 (y[[i-2]] + y[[i+2]]) +
7 y[[i]] + 6 (y[[i-1]] + y[[i+1]]))/21],
{i, 4, nm}];
AppendTo[z,(y[[n-6]] - 4 y[[n-5]] + 2 y[[n-4]] +
12 y[[n-3]] + 19 y[[n-2]] +
16 y[[n-1]] - 4 y[[n]])/42];
AppendTo[z, (4 y[[n-6]] - 7 y[[n-5]] - 4 y[[n-4]] +
6 y[[n-3]] + 16 y[[n-2]] +
19 y[[n-1]] + 8 y[[n]])/42];
AppendTo[z, (-2 y[[n-6]] + 4 y[[n-5]] + y[[n-4]] -
4 y[[n-3]] - 4 y[[n-2]] +
8 y[[n-1]] + 39 y[[n]])/42];
z
] /; METHOD == 1 || METHOD == 2 ||
METHOD == 3 || METHOD == 4 || METHOD == 5
End[] (* end Private Context *)
EndPackage[] (* end Smoothing Context *)
(* %%%%%%%%%%%%%%%%%%%%% The end of smoothi.m file %%%%%%%%%%%%%%%%%%%%% *)