Показать сообщение отдельно
Старый 20.10.2014, 21:12   #18 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Нарисовал вариантик программы. Изменения:
1. Введены (константами) число строк (Nl) и столбцов (Nc) исходной матрицы. Явные тройки и семерки убраны.
2. Вычисляются суммы квадратов отклонений от нуля при:
а) простом суммировании рядов, т.е. когда все коэффициенты равны 1;
б) после нахождения минимизирующих коэффициентов;
в) после нахождения минимизирующих коэффициентов при обмене местами первой и второй строк, т.е. когда второй массив становится "базовым", а первый занимает его место. Как показал расчет, результат при этом меняется, так что, возможно, есть смысл еще и перебрать массивы, поочередно каждый из них делая "базовым".
Осталось только организовать ввод массивов из файла или с клавиатуры, ну это уж Вы сами. У меня для тестирования массив задан в виде константы, что, конечно, в универсальной программе не годится.
Код:
Const
 Nl=4;
 Nc=7;

Type
 matr=array [1..Nl-1,1..Nl-1] of real;
 matr_S=array [1..Nl,1..Nc] of real;
 mas=array [1..Nl-1] of real;
 vect=array [1..Nl] of real;

Const
 M1:Matr_S=(( 57, -25, -74, -47, -73,  16,  41),
            (-43, -81,  90, -79, -73,  32, -29),
            (-71,  -9,  76, -50,  34,  52, -19),
            ( 54,  98,  69,  70,  93, -31,  14));
 eps=0.00001;

Var
 M:Matr_S;
 i,j,p:integer;
 b,x:mas;
 C:vect;
 a:matr;
 Dummy:real;

function Sum(MS:Matr_S;CS:vect):real;
var
 f,g:integer;
 SS,SL:real;
begin
 SS:=0;
 for g:=1 to Nc do
  begin
   SL:=0;
   for f:=1 to Nl do SL:=SL+CS[f]*MS[f,g];
   SS:=SS+Sqr(SL);
  end;
 Sum:=SS;
end;

procedure Gauss(ag:matr; bg:mas; var xg:mas; Ng:integer);
 Var
  k,ig,jg:byte;
  m,s:real;
  blg:boolean;
  c:mas;
 begin
  for k:=1 to Ng-1 do
   begin
    if ABS(ag[k,k])<eps then
     begin
      ig:=k;
      blg:=false;
      repeat
       Inc(ig);
       if ABS(ag[ig,k])>eps then
        begin
         blg:=true;
         c:=ag[k];
         ag[k]:=ag[ig];
         ag[ig]:=c;
         s:=bg[k];
         bg[k]:=bg[ig];
         bg[ig]:=s;
        end;
      until blg;
     end;
    m:=ag[k,k];
    for jg:=k to Ng do
     ag[k,jg]:=ag[k,jg]/m;
    bg[k]:=bg[k]/m;
    for ig:=k+1 to Ng do
     if ABS(ag[ig,k])>eps then
      begin
       m:=ag[ig,k];
       for jg:=k to Ng do
        ag[ig,jg]:=ag[k,jg]-ag[ig,jg]/m;
       bg[ig]:=bg[k]-bg[ig]/m;
      end
     else
      ag[ig,k]:=0;
   end;
 xg[Ng]:=bg[Ng]/ag[Ng,Ng] ;
 for ig:=(Ng-1) downto 1 do
  begin
   s:=0;
   For jg:=ig+1 to Ng do
    s:=s+ag[ig,jg]*xg[jg] ;
   xg[ig]:=bg[ig]-s;
  end;
end;

Begin
 M:=M1;
 for i:=1 to Nl-1 do
  begin
   for j:=1 to Nl-1 do a[i,j]:=0;
   b[i]:=0;
  end;
 for i:=1 to Nl-1 do
  for j:=1 to Nl-1 do
   for p:=1 to Nc do
    a[i,j]:=a[i,j]+M[j+1,p]*M[i+1,p];
 for i:=1 to Nl-1 do
  begin
   for p:=1 to Nc do b[i]:=b[i]+M[1,p]*M[i+1,p];
   b[i]:=-b[i];
  end;

 for i:=1 to Nl do C[i]:=1;
 Writeln('Mean square sum with Ci=1 (i=1..4): ',Sum(M,C):0:3);
 Writeln;
 Gauss(a,b,x,Nl-1);
 Writeln('Result of calculation:');
 for i:=1 to Nl do
  begin
   if i>1 then C[i]:=x[i-1];
   writeln('C[',i,'] = ',C[i]:8:5);
  end;
 Writeln('Mean square sum with calculated Ci (i=1..4): ',Sum(M,C):0:3);
 Writeln;
 for j:=1 to Nc do
  begin
   Dummy:=M[1,j];
   M[1,j]:=M[2,j];
   M[2,j]:=Dummy;
  end;
 Writeln('After exchanging of first and second lines:');
 for i:=1 to Nl-1 do
  begin
   for j:=1 to Nl-1 do a[i,j]:=0;
   b[i]:=0;
  end;
 for i:=1 to Nl-1 do
  for j:=1 to Nl-1 do
   for p:=1 to Nc do
    a[i,j]:=a[i,j]+M[j+1,p]*M[i+1,p];
 for i:=1 to Nl-1 do
  begin
   for p:=1 to Nc do b[i]:=b[i]+M[1,p]*M[i+1,p];
   b[i]:=-b[i];
  end;
 Gauss(a,b,x,Nl-1);
 Writeln('Result of calculation:');
 for i:=1 to Nl do
  begin
   if i>1 then C[i]:=x[i-1];
   writeln('C[',i,'] = ',C[i]:8:5);
  end;
 Writeln('Mean square sum with calculated Ci (i=1..4): ',Sum(M,C):0:3);
 Readln
End.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070