Текст подпрограммы и версий
is03r_p.zip , is03e_p.zip 		Тексты тестовых примеров
tis03r_p.zip , tis03e_p.zip

Подпрограмма:  IS03R (модуль IS03R_p)

Назначение

Среднеквадратическое сглаживание дискретно заданной функции сплайном k - го порядка.

Математическое описание

Пусть в узлах  xi :  x1 < x2 < ...< xl , заданы значения табличной функции  gi . Строится сглаживающая сплайн - функция 

                 n
    f(x) =   ∑   ai Ni k (x) ,  определяемая условиями :
               i=1
      l
     ∑  wi ( gi - f( xi ) )2  -  min a  ;
    i=1

здесь  wi > 0 - заданные весовые коэффициенты, Ni k,  i = 1, ..., n - нормированные В - сплайны k - го порядка, соответствующие узлам  ti, ti + 1, ..., ti + k таким, что :  t1 ≤ t2 ≤ ...≤ tk < tk + 1 < ...< tn < tn + 1 ≤ ... ≤ tn + k. При этом требуется, чтобы  tk ≤x1 < xl ≤ tn + 1,  а  l ≥ n.

C. de Boor, Package for Calculating with B - splines, SIAM J. Numerical Analysis, 14(3), 1977, pp. 441-472.

Использование 

procedure IS03R(N :Integer; K :Integer; LX :Integer;
                var T :Array of Real; var X :Array of Real;
                var G :Array of Real; var W :Array of Real;
                var A :Array of Real; var R :Array of Real;
                var R1 :Array of Real; var R2 :Array of Real;
                var IERR :Integer);


   Параметры
N - заданное число нормированных В - сплайнов (тип: целый);
K - заданный порядок В - сплайна (тип: целый);
LX - заданное число узлов аппроксимации, LX ≥ N (тип: целый);
T - вещественный вектоp длины N + K заданных значений узлов сплайна: T (1) ≤ T (2) ≤ ...≤ T (k) < T (k + 1) < ...< T (N + 1) ≤ T (N + 2) ≤ ...≤ T (N + K);
X - вещественный вектоp длины LX заданных значений узлов аппроксимации:  T (K) ≤ X (1) < X (2) < ... < X (LX) ≤ T (N + 1);
G - вещественный вектоp длины LX заданных значений сглаживаемой функции, G (I) = gi ,  I = 1, 2, ..., LX;
W - вещественный вектоp длины LX весовых коэффициентов W (I) = WI > 0 ,  I = 1, 2, ..., LX;
A - вещественный вектоp длины N, коэффициентов сглаживающего сплайна,  aI = A (I) ,  I = 1, 2, ..., N;
R - вещественный двумерный рабочий массив размера N на (2*K - 1);
R1 - вещественный рабочий вектоp длины K;
R2 - вещественный двумерный рабочий массив размера N на K;
IERR - целая переменная, служащая для сообщения об ошибках, обнаруженных в ходе работы подпрограммы; при этом:
IERR=65 - если матрица нормальной системы уpавнений для определения коэффициентов сглаживающего сплайна вырождена. 
   Версии
IS03E - среднеквадратическое сглаживание дискретно заданной функции сплайном k - го порядка с расширенной (Extended) точностью. Массивы T, X, G, W, A, R, R1, R2 имеют тип Extended. 
   Вызываемые подпрограммы
UTIS10 - подпрограмма выдачи диагностических сообщений при работе подпрограммы IS03R.
UTIS11 - подпрограмма выдачи диагностических сообщений при работе подпрограммы IS03E.
ASB1R - решение системы линейных алгебраических уpавнений с ленточной матрицей, заданной в компактной форме, с выбором ведущего элемента по столбцу.
ASB1E - решение системы линейных алгебраических уpавнений с ленточной матрицей, заданной в компактной форме с расширенной (Extended) точностью (выбор ведущего элемента по столбцу). 
   Замечания по использованию
  В подпрограммах IS03R, IS03E используются служебные подпрограммы I I21R1, I I21E1.

Пример использования 

Unit TIS03R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, IS03R_p;

function TIS03R: String;

implementation

function TIS03R: String;
var
N,LX,K,I,_i,IERR :Integer;
ХХ :Real;
X :Array [0..11] of Real;
G :Array [0..11] of Real;
A :Array [0..5] of Real;
R :Array [0..29] of Real;
R1 :Array [0..2] of Real;
R2 :Array [0..17] of Real;
const
T :Array [0..8] of Real = ( 0.0,0.0,0.0,2.0,4.0,6.0,8.0,8.0,8.0 );
W :Array [0..11] of Real = ( 1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0 );
label
_5;
begin
Result := '';  { результат функции }
N := 6;
LX := 12;
K := 3;
for I:=1 to LX do
 begin
  ХХ := 0.5+0.5*(I);
  X[I-1] := XX;
  G[I-1] := XX*XX*XX;
_5:
 end;
Result := Result + Format('%s',
 [' ТЕСТОВЫЙ ПРИМЕР ДЛЯ IS03R ']) + #$0D#$0A; 
IS03R(N,K,LX,T,X,G,W,A,R,R1,R2,IERR);
Result := Result + Format('%s',[' REЗYЛЬTATЫ:' + #$0D#$0A + ' IERR=']);
Result := Result + Format('%3d ',[IERR]);
Result := Result + Format('%s',[' КОЭФФИЦИЕНТЫ A=' + #$0D#$0A]);
Result := Result + #$0D#$0A;
for _i:=0 to 5 do
 begin
  Result := Result + Format('%20.16f ',[A[_i]]);
  if ( ((_i+1) mod 3)=0 )
   then Result := Result + #$0D#$0A;
 end;
Result := Result + #$0D#$0A;
UtRes('TIS03R',Result);  { вывод результатов в файл TIS03R.res }
exit;
end;

end.

Результаты:

       IERR  =  0
       
       A  =  ( .290,  -2.236,  18.081,  110.,  321.72,  520.93 )