(*~\Глагол\ПриложенияЛинАл\64\д\СистЛАУдейств\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
(**)                                    ОТДЕЛ ПроQR+;
(*============================================================================*
 * НАЗНАЧЕНИЕ: решение систем линейных уравнений (A*x=b) методом QR разложения
 * ПРИМЕЧАНИЯ: 
 *     Система уравнений записана в файле "ПроМатр2.дан".
 *     В этом файле 1-я строка содержит размер матрицы A
 *  (число строк и столбцов), в следующих строках записанны значения элементов
 *  матрицы A, потом на отдельной строке размер матрицы свободных членов B
 *  (число векторов b и их размер), а далее значения элементов матрицы B, 
 *  в которой строки являются векторами b.
 *     Прямоугольная матрица A (N на M, с N >= M) раскладывается на два
 *  сомножителя (A=Q*R), где Q (N на M) ортогональная матрица, а
 *  R (M на M) - верхняя треугольная матрица. Получаем Q*R*x = b, далее
 *  R*x = Q'b. Последняя система решается методом обратной подстановки.
 *     Если система несовместна (N > M), то метод возвращает такой вектор x,
 *  для которого A*x является наилучшим приближением к b (по норме). 
 *============================================================================*)

ИСПОЛЬЗУЕТ
 дМатрица ИЗ "..\..\..\..\Отделы\ЧисАн\64\д\",

 дМатрВВ  ИЗ "..\..\..\..\Отделы\ЧисАн\64\д\ВводВывод\",
 дВектВВ  ИЗ "..\..\..\..\Отделы\ЧисАн\64\д\ВводВывод\",

 дСистЛАУ ИЗ "..\..\..\..\Отделы\ЛинАл\64\д\",

  ИзФайла ИЗ "..\..\..\..\Отделы\Обмен\ВводВывод\",
  НаЭкран ИЗ "..\..\..\..\Отделы\Обмен\ВводВывод\";

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА Голова;
ПОСТ
  TOL=1.D-8; (* собственные значения обнуляются, если они более
              * чем в TOL раз меньше наибольшего собственного значения *)
ПЕР
  n :ЦЕЛ; (* размер вектора свободных членов *)
  nv:ЦЕЛ; (* число векторов свободных членов *)

  A:дМатрица.Доступ; (* матрица системы *)
  R:дМатрица.Доступ; (* верхняя треугольная матрица *)
  B:дМатрица.Доступ; (* вектора свободных членов *)
  X:дМатрица.Доступ; (* вектора решения *)

  i:ЦЕЛ; 
  ч:ИзФайла.ДкПотоку;

УКАЗ
  ч:=дМатрВВ.ОткрытиеФайла("ПроМатр2.дан");
  A:=дМатрВВ.изФайла(ч);
  B:=дМатрВВ.изФайла(ч);
             ИзФайла.Закрыть(ч);
  nv:=РАЗМЕР(B^,0);
  n:=РАЗМЕР(B^,1);

  СОЗДАТЬ(R,n,n);
  СОЗДАТЬ(X,nv,n);

    НаЭкран.ВсяЦепь("^Исходная матрица:^");

  дМатрВВ.наЭкран("%10.5f",A^);

    НаЭкран.ВсяЦепь("^Вектора свободных членов:^");
  ОТ i:=0 ДО nv-1 ВЫП
    дВектВВ.наЭкран("%10.5f",B[i])
  КОН;
   (* После выполнения РазложитьНаQR матрица Q оказывается на месте матрицы A *)
  ЕСЛИ 
       дСистЛАУ.РазложитьНаQR(A^,R^) = 0
  ТО
                     (* решаем систему для каждого вектора свободных членов b *)
    НаЭкран.ВсяЦепь("^Вектора решения:^");

    ОТ i:=0 ДО nv-1 ВЫП
      дСистЛАУ.РешитьИзQR (A^,R^,B[i],X[i]); 
      дВектВВ.наЭкран("%10.5f",X[i])
    КОН
  ИНАЧЕ
    НаЭкран.ВсяЦепь("^Вырожденная матрица!^")
  КОН
КОН Голова;

(*-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-*)
УКАЗ
  Голова
КОН ПроQR.
