Текст подпрограммы и версий
asp0r_p.zip , asp0e_p.zip , asp0c_p.zip 		Тексты тестовых примеров
tasp0r_p.zip , tasp0e_p.zip , tasp0c_p.zip

Подпрограмма:  ASP0R (модуль ASP0R_p)

Назначение

Нахождение нормального псевдорешения переопределенной системы линейных алгебраических уравнений полного ранга методом отражений.

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

Находится нормальное псевдорешение системы АX = B, где А - матрица полного ранга размера N на М (N ≥ М), В - заданный вектор длины N. Для решения используется нормализованное приведение матрицы системы к верхней треугольной форме R с помощью последовательности преобразований отражения 

 (1)     QMQM-1...Q1AS = R ,

где Qi - соответствующие матрицы отражения, S - результирующая матрица перестановок, R - верхняя треугольная матрица размера N на М.

Из полученной треугольной системы 

        RY = QMQM-1...Q1B

находится нормальное псевдорешение Y, по которому затем определяется искомое решение Х = SY.

Д.К.Фадеев, В.Н.Фадеева, В.Н.Кублановская, О решении линейных алгебраических систем с прямоугольными матрицами. Тp. Мат. ин-та АН СССР, 1968, 96.

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

procedure ASP0R(var A :Array of Real; var B :Array of Real;
                var X :Array of Real; var T :Array of Real;
                var S :Array of Integer; N :Integer; M :Integer;
                L :Integer);


   Параметры
A - вещественный двумерный массив размера N на М (N ≥ М), в котором задается исходная матрица А; в результате работы подпрограммы в массиве А на соответствующих местах запоминаются наддиагональные элементы вычисленной верхней треугольной матрицы R; в остальной части массива А в последовательных столбцах запоминаются векторы, порождающие соответствующие матрицы отражения;
B - вещественный вектор длины N, в котором задается правая часть системы;
X - вещественный вектор длины М, в котором запоминается найденное псевдорешение системы;
T - вещественный вектор длины N, используемый подпрограммой как рабочий; в результате работы подпрограммы в первых М компонентах массива Т запоминаются диагональные элементы верхней треугольной матрицы R;
IS - целый вектор длины М, в котором запоминаются перестановки столбцов при проведении нормализованного процесса (1); в IS (k) запоминается номер столбца переставленного с k - ым столбцом на k - ом шаге преобразования;
N, M - число строк и столбцов исходной матрицы А, N ≥ М (тип: целый);
L - задает режим работы подпрограммы (тип: целый); при этом:
L = 1 - если система с данной матрицей А решается в первый раз;
L ≠ 1 - если система решается повторно с той же матрицей А, но с другой правой частью; в этом случае разложение (1) матрицы А не выполняется. 
   Версии
ASP0E - нахождение нормального псевдорешения переопределенной системы линейных алгебраических уравнений полного ранга, заданной с расширенной (Extended) точностью, методом отражений.
ASP0C - нахождение нормального псевдорешения комплексной переопределенной системы линейных алгебраических уравнений полного ранга методом отражений. 
   Вызываемые подпрограммы:  нет 
   Замечания по использованию
  1. 

В подпрограмме АSР0С параметры А, В, Х, Т имеют тип Complex.

  2. 

В подпрограмме АSР0E параметры А, В, Х, Т имеют тип Extended.

  3.  При повторном решении системы с той же матрицей, информация, полученная ранее в массивах А, Т, IS, не должна портиться.

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

Unit TASP0R_p;
interface
uses
SysUtils, Math, { Delphi }
Lstruct, Lfunc, UtRes_p, ASP0R_p;

function TASP0R: String;

implementation

function TASP0R: String;
var
P,I,J,K,_i :Integer;
DАТАВ :Real;
B :Array [0..4] of Real;
X :Array [0..3] of Real;
T :Array [0..4] of Real;
S :Array [0..3] of Integer;
A1 :Array [0..19] of Real;
const
A :Array [0..19] of Real = ( 2520.0,1260.0,840.0,630.0,504.0,1260.0,840.0,
630.0,504.0,420.0,840.0,630.0,504.0,420.0,360.0,
630.0,504.0,420.0,360.0,315.0 );
B1 :Array [0..4] of Real = ( 5250.0,3234.0,2394.0,1914.0,1599.0 );
label
_92,_91,_9;
begin
Result := '';  { результат функции }
for I:=1 to 5 do
 begin
  for J:=1 to 4 do
   begin
_92:
    A1[(I-1)+(J-1)*5] := A[(I-1)+(J-1)*5];
   end;
 end;
for K:=1 to 2 do
 begin
  Result := Result + Format('%s',
 ['          РЕШЕНИЕ ПЕРЕОПРЕДЕЛЕННОЙ СИСТЕМЫ AX=B ПОЛНОГО PAHГA' + #$0D#$0A +
 '          МЕТОДОМ ОТРАЖЕНИЙ ДЛЯ ВЕЩЕСТВЕННЫХ A И B' + #$0D#$0A]) + #$0D#$0A; 
  Result := Result + Format('%s',[' ИСХОДНЫЕ ДAHHЫE']) + #$0D#$0A; 
  Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' A' + #$0D#$0A]);
  for I:=1 to 5 do
   begin
    for J:=1 to 4 do
     begin
      Result := Result + Format('%20.16f ',
 [A[(I-1)+(J-1)*5]]) + #$0D#$0A;
     end;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[' B' + #$0D#$0A]);
  Result := Result + #$0D#$0A;
  for _i:=0 to 4 do
   begin
    Result := Result + Format('%20.16f ',[B[_i]]);
    if ( ((_i+1) mod 4)=0 )
     then Result := Result + #$0D#$0A;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[' PEЗYЛЬTAT:' + #$0D#$0A]) + #$0D#$0A; 
  P := 1;
  ASP0R(A,B,X,T,S,5,4,P);
  Result := Result + #$0D#$0A;
Result := Result + Format('%s',[' A' + #$0D#$0A]);
  for I:=1 to 5 do
   begin
    for J:=1 to 4 do
     begin
      Result := Result + Format('%20.16f ',
 [A[(I-1)+(J-1)*5]]) + #$0D#$0A;
     end;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[' T' + #$0D#$0A]);
  Result := Result + #$0D#$0A;
  for _i:=0 to 4 do
   begin
    Result := Result + Format('%20.16f ',[T[_i]]);
    if ( ((_i+1) mod 4)=0 )
     then Result := Result + #$0D#$0A;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[#$0D#$0A + ' S ']);
  Result := Result + #$0D#$0A;
  for _i:=0 to 3 do
   begin
    Result := Result + Format('%4d ',[S[_i]]);
    if ( ((_i+1) mod 4)=0 )
     then Result := Result + #$0D#$0A;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[' B' + #$0D#$0A]);
  Result := Result + #$0D#$0A;
  for _i:=0 to 4 do
   begin
    Result := Result + Format('%20.16f ',[B[_i]]);
    if ( ((_i+1) mod 4)=0 )
     then Result := Result + #$0D#$0A;
   end;
  Result := Result + #$0D#$0A;
  Result := Result + Format('%s',[#$0D#$0A + ' X' + #$0D#$0A]);
  Result := Result + #$0D#$0A;
  for _i:=0 to 3 do
   begin
    Result := Result + Format('%20.16f ',[X[_i]]);
    if ( ((_i+1) mod 4)=0 )
     then Result := Result + #$0D#$0A;
   end;
  Result := Result + #$0D#$0A;
  for I:=1 to 5 do
   begin
    B[I-1] := B1[I-1];
    for J:=1 to 4 do
     begin
_91:
      A[(I-1)+(J-1)*5] := A1[(I-1)+(J-1)*5];
     end;
   end;
_9:
 end;
UtRes('TASP0R',Result);  { вывод результатов в файл TASP0R.res }
exit;
end;

end.


Результат:

      X  =   (1.00000000005, 0.500000000016, 0.3333333334, 0.25000000003, 0.20000000001)