4. Программы на языке алгол

procedure svd (m, п, withu, withv, eps, tol) data : (a) result: (q, u, v)\ value m, n, with w, with v, eps, tol;

integer m, n\ boolean with u, with v, real eps, tol] array a, q_t u, v\ comment — вычисление сингулярных значений и полное ортогональное разложение действительной прямоугольной матрицы А в виде А= U diag (q) V^T, U^TU = v^t V = 1. Массивы a [1 : /n, 1 : n], и [1 : m, 1 : n], v [1 : л, 1 : n], q [1 : п] предназначены для размещения матриц A, U, V и diag (q) соответственно. Фактические массивы, обозначенные а, и, v, могут быть тождественно равными, если не выполняется условие with и = with v = true. При выполнении этого условия фактические параметры, соответствующие массивам и и v, должны быть различными. В процедуре предполагается, что т ^п

\ begin

integer /, /, k, /, 11; real с, /, g, h, s, x, y, z\ array e[\ : ri\\

for i : = 1 step 1 until m do

for / : = 1 step 1 until n do и [i, j] : = a [i, /];

comment — приведение исходной матрицы к двухдиагональной форме

с помощью преобразования Хаусхолдера;

g: = Jt: = 0;

for i : = 1 step 1 until n do

стр132

begin

\i\: = g; J « 0; {:«*+!;

for /:=1 step 1 until m do s ! = 5 -J- и [/, <] f 2;

if s < to/ then gi = 0 else begin

/ 1 = и [i, i]; g ; = tf / < 0 then 6<yr/ (s) else — sqr

for / : = / step 1 until n do

begin

s r = 0;

for /г : = i step 1 until m do s t = s 4- w [k, i\xu [k, /Jj f:=s'//i;

for k i = t step 1 until m do и [k, j]i = u[k. Л + /ХМ [/г. 0 end / end s;

q[i]: = g\ s: = 0;

for / 1 «= / step 1 until n do s t = s -{- z/ [t, /] f 2* if s < Ы then g; = 0 else begin

f:**u [i, H- 1 ]; g i = if / < 0 then sqrt (s) else — sqrt (s)5

*. k];

for / : = / step 1 until n do <? [/J : = и [i, /]//i;

for / : = / step 1 until m do

begin

s : = 0;

for k : = / step 1 until rc do s : = s + и [/, /г]Х

Хи[ for & : = / step 1 until n do и [у, &] : = и [у, А¹]

end / end s;

y: = abs (q [i]) -f abs (e [/]); if # > к then л; t = у end /;

comment — формирование результирующей матрицы правых преобразований;

if with v then for i : = /г step — 1 until 1 dc begin

if g=f 0 then begin

Л:«и {*, Л- 1]хг»

for | : = / step 1 until n do у [у, /] : = и [i, f]/h}

for у : = / step 1 until n do

begin

s: =0;

for k i = / step 1 until n do s : = s + и [i, k]xv [k, /];

for k i = / step 1 until n do у [/г, у] t « у [/г, у] + sX

Xv [k> i] end у end g^;

for у : = / step 1 until n do v [t, }] : = v [/, /] i = 0; о I/, «i«i; gi = ^ [П; /r«=*

end f;

comment — формирование результирующей матрицы левых преобразований}

if withu then for i : = n step — 1 until 1 do

begin

/: = i-M; g:=<? [<];

for/: = / step 1 until n do w [i, y]': = 0j

if gi= 0 then

begin

h:*=u[i_t i]xgl

for у : = / step 1 until я do

begin

s : — 0;

for /г : = /step 1 until m do 5 : == s + и [k, i]xu[k_t /]; / : = s/h;

for k: — i step 1 until m do и [k_t j] : = и [&, /] 4-

+ /ХИ [Ј, t] end /;

for у : = t step 1 until m do и [у, /] : = и [у, /]/g end g

else for j : ~ i step 1 until m do и [у, /] : = 0; w[i, /]: = u [i, /]+ 1 end i;

comment — приведение двухдиагональной матрицы к диагональной форме; eps : =epsxx-,

for k: — n step — 1 until 1 do begin test f splitting:

for / : = k step — 1 until 1 do begin

if abs (e [l])^eps then go to test f convergence', if abs (q [/ — l])^eps then go to cancellation end /;

comment — аннулирование элемента e [/], если / > 1; cancellation :

с: =0; s: = 1; 11 : = /—!; for i: = l step 1 until & do begin

'

.

if abs (f)^eps then go to test f convergence] g: = q[i];h: =q[i] : = sqrt (fXf + gXg)', c:=g/h',s:=—f/h;

if withu then for у : — 1 step 1 until m do begin

y: = u[j, 11]; z: = u [/, i]; «[/» ^1 : =f/Xc-t-zXs; w [y, t] : = — t end end i;

test f convergence :

z : = q [k]; if / = k then go to convergence;

comment — формирование сдвига для (^/^-преобразования; *: = ? [/];

y: = q[k—\]; g: = e[k-l]; h: = e[k];

f'- = ((y-z)X(y + z) + (g-h)X(g + h))/(2xhxy); g : = sqrt (/X X/+1);

/_:==((л;__₂)Х (x + z) + hx(y/(iif<0 then f-g else / +g) —

— л))/лрз

comment — очередной шаг Q/^-преобразования;

for /: = / + ! step 1 until k do begin

g : = e [i]; y: = q [i]\ h : = sxg; g : = cXg;

e[i — 1] : =z: =sqrt(fxf^j_rhxh); с : = f/z; s : = h/z;

f:=xxc~}-gxs; g_: = —xXs + gXc; h : = yXs; y:=yXc;

if ш/Ду then for у : = 1 step 1 until n do

begin

x: = v [/,/—!]; z:=--y[/, f];

у [у, i— 1] : =xxc + zXs; v [y, i] : = —

end y;

^ [/— 1]: = г; = 5^г/ (fxf + hxh); с: = //г; s:=h/z;

f : = cxg + sXy; x: = — sXg + cXy;

if withu then for /: = 1 step 1 until m do

begin

«/: = "[/> «'— 1]; z : = "[/» i]; «[/» «'— l]:=#xc-f 2Xs; и[/, t]: = — i end / end /;

e[/]: = 0; <?[&]: = /;<?[&]:=*; goto test f splitting; convergence: if г < 0 then begin

comment — формирование элементов массива q[k]_t состоящего из неотрицателых элементов;

if* with) then for /: = 1 step 1 until n do

v [/, k]: = — v [/, k]

end г, end k end sud;

procedure minfit (m, л, p, eps, tol) trans : (ab) result : (q); value m, л, p, eps, to/; integer m, л, p; real eps, /0/; array ab, q; comment — вычисление матриц diag (q), V и С, которые связаны с исходными действительными матрицами А размера т X п и В размера т X р следующим соотношением L^AV = diag (q) и lljB = С. Здесь V и U_c — ортогональные матрицы. Сингулярные числа и матрицы V и С могут быть использованы для определения матрицы X, минимизирующей норму ||АХ — в||е или ||X|JE. Матрица X может быть сформирована следующим образом!

X = V X diag* (q) X С.

Процедура также позволяет вычислять общее решение недоопределенной линейной системы уравнений, ранг которой т меньше п. Массив q [1 : п] содержит матрицу diag [q]. Матрицы А и В заданы в первых т строках массива ab [1 : max (m, л), 1 : л -f- p]. В результате вычислений матрица V будет размещена в первых п строках и столбцах массива ab, а матрица С — в последних р столбцах массива ab (если р > 0);

begin

integer i, /, k, I, 11, nl, np; real c, /, g, л, s, x, y, z; array e [1 : л];

comment —- приведение исходной матрицы к двухдиагональной форме с помощью преобразований Хаусхолдера: g : = х : = 0; лр : = п -f- p;

tor i : =• 1 step 1 until л do begin

e [t]: = g; s : = 0; /: = *+ 1;

for / : = / step 1 until m do s : = s + ab [/, i] f 2;

if s < tol then g : = 0 else

begin

f: = ab [i, i]; g : = if / < 0 th:n sqrt (s) else — sqrt (s);

h: = fXg — s; ab [/, /]: = / — g;

for /: = / step 1 until лр do

begin

s: = 0;

for k : = i step 1 until m do s : = s + ab [k, i] xab [k, /];

/: = s/h;

f or k : = i step 1 until m do ab [k_t /]: = ab [h 'Xab[k, i]

end s;

q

if

end j

then for / : = I step 1 until n do s ; = s + ab [i_t j] 12j

135

if s < tol then g : = 0 else

begin

f : = ab [i, i+l]; g : = if / < 0 then sqrt (s) else~*</r/(s);

h:=fXg-s', ab (i. ;+l]_:==/-g_;

for / : = / step 1 until n do e [j] : = ab [i_t j]/h;

for / : = / step 1 until m do

begin

s : = 0;

for k : = / step 1 until л do s: =*6 + ab [/, Л] X a6 [/, ^]; for k : = / step 1 until /г do ab [/, k] : = 06 [/, aj] + s X e [k] end / end s;

у : =abs (q [i]) + abs (e [/]); if i/ > x then * : = у end t;

comment — формирование результирующей двухдиагональной матрицы правых преобразований; for i: = n step— I until 1 do begin

if g^O then begin

h:=ab [i, i+ l]Xg\

for / : = / step 1 until n do ab [/, i] : = ab [i, j]lh\

for / : = / step 1 until n do

begin

s : == 0;

for k : = / step 1 until n do

for k : = I step 1 until n do

06 [k, j]: = ab [k, j] + sxab[k, i] end / end g;

for j : = / step 1 until л do «6 [i, j] : = a6 [/, i] : == 0; ab [i, i\ : = 1; g: = e[i]; /: =f

end i\

eps : = epsXA:; л/ : = л + 1 ;

for Ј : = m + 1 step 1 until л do

for / : = nl step 1 until np do ab [i, j] : = 0,

comment — приведение двухдиагональной матрицы к диагональной форме;

for k : = п step — 1 until 1 do

begin

test f splitting:

for / : — k step — 1 until 1 do begin

if a&s (e [ /]) ^ eps then go to test f convergence;

if abs (q [I — i]) ^eps then go to cancellation

end /;

comment — аннулирование элемента e[l], если />1; cancellation:

c: =0; s: = 1; //:-=/—!; for/ : = / step 1 until k do begin

/ : = sxe [/]; e [i] : = cXe [i];

if abs (f)'^eps then go to tes^ / convergence;

g:=q(i}; q[i]:=h:=sqrt (fXf + gXg)\ с : = g/h; s: =

•

for / : = n 1 step 1 until np do

begin

136

y:*=ab[U_t /]; z:=*ab [*,/]; ab (11, /]: = 6Xf/-f sxz; ab[i, /] : = — sxy + end / tnd /

/ convergence:

г : = <?[/г|; if / = & then go to convergence;

comment — формирование сдвига для Q/^-преобразования; г — 1]; g:=e [k—\]- h: = e[k]\

f : = ((x — г) х (л: -f 2) + hx(y/(it f < 0 then / — g else / + g) J.

— h))fx\

comment — очередной шаг QR -преобразования; с : = s : = 1 ;

for t : =» / + 1 step 1 until k do begin

g : = e [i]', y: = q [i]; h : = sXg; g : = cXg; U.r-ll :^z:=sqrt (fXf + hXh); с : = //г; s: = /г/г;

for / : = 1 step 1 until n do begin

[/, f — 1] _: == xxc+zxs] ab[j, t] s = — x

end /;

q [i — l]:=*z:

sqrt (fxf + hxh); с : = //г; s : = /i/z;

for / : = ш step 1 until np do begin

t, _: = aft [г — 1 , /]; z : = ab (i, ;]; aM* — 1; /l: = cxy + sxz; ab [t,

. , end /

end i;

e [/] : = 0; e [Л] : = /; q [k] : = x\ go to test f splitting; convergence;

if z<0 then begin

comment — формирование массива q [k], состоящего из неотрицательных элементов;

end k

end minfit\.

end г

for /' : = 1 step 1 until n do ab [i, k] : = —ab [j_t k]',