Форум программистов [Powered by Invision Power Board]

Код


Function tdesslau.Gaus: Boolean;
Var
  i,j,k,l:Integer;
  a:array [1..3,1..4] of real;
  w,m,t:real;
Begin
  form1.Memo2.Lines.Clear;
  for i:=1 to 3 do
    for j:=1 to 4 do a[i,j]:=q[i,j];
  For k:=1 to 2 do
    begin
      l:=0; m:=0;
      For i:=k to 3 do
        If Abs(a[i,k])>m then begin
          m:=Abs(a[i,k]);
          l:=i;
        end;
      If l=0 then begin
        form1.memo2.Lines.clear;
        form1.memo2.Lines.Add('система методом Гаусса не решается');;
        Exit;
      end;
      If l<>k then begin
        For j:=1 to 3 do begin
          t:=a[k,j];
          a[k,j]:=a[l,j];
          a[l,j]:=t;
        end;
        t:=a[k,4];
        a[k,4]:=a[l,4];
        a[l,4]:=t;
      end;
      For i:=k+1 to 3 do begin
        if a[k,k]=0 then begin
          form1.memo2.Lines.clear;
          form1.memo2.Lines.Add('система методом Гаусса не решается');
          exit;
                         end;
        w:=a[i,k]/a[k,k];
        For j:=1 to 3 do
          If j=k then a[i,j]:=0
          else a[i,j]:=a[i,j]-w*a[k,j];
        a[i,4]:=a[i,4]-w*a[k,4];
      end;
     end;
     if a[3,3]=0 then
       begin
         form1.memo2.Lines.clear;
         form1.memo2.Lines.Add('система методом Гаусса не решается');
         exit;
       end;
     xk[3]:=a[3,4]/a[3,3];
     For i:=2 downto 1 do begin
         t:=0;
         For j:=1 to 3-i do t:=t+a[i,i+j]*xk[i+j];
          if a[i,i]=0 then
            begin
              form1.memo2.Lines.clear;
              form1.memo2.Lines.Add('система методом Гаусса не решается');
              exit;
            end;
         xk[i]:=(1/a[i,i])*(a[i,4]-t);
     end;

     for i:=1 to 3 do
       form1.memo2.Lines.Add(floattostr(xk[i]));
End;

procedure TDesSLAU.opr3(ax:a3; var d:integer);
    begin
     d:=ax[1,1]*ax[2,2]*ax[3,3]+ax[1,3]*ax[2,1]*ax[3,2]
     +ax[1,2]*ax[2,3]*ax[3,1]-ax[3,1]*ax[2,2]*ax[1,3]
     -ax[2,1]*ax[1,2]*ax[3,3]-ax[3,2]*ax[2,3]*ax[1,1];
    end;

function tdesslau.kramer:boolean;
var az:a3;
 i,j,d,d1:integer;
 x:array[1..3] of real;
begin
  form1.memo1.lines.clear;
  for i:=1 to 3 do
    for j:=1 to 3 do az[i,j]:=q[i,j];
   slau.opr3(az,d);
   if d=0 then
       begin
         form1.memo1.lines.add('определитель равен нулю,система методом Крамера не решается');
         exit;  
       end;
    for i:=1 to 3 do
      for j:=2 to 3 do az[i,j]:=q[i,j];
      for i:=1 to 3 do az[i,1]:=q[i,4];
   slau.opr3(az,d1);
   x[1]:=d1/d;
    for i:=1 to 3 do az[i,1]:=q[i,1];
    for i:=1 to 3 do az[i,2]:=q[i,4];
    for i:=1 to 3 do az[i,3]:=q[i,3];
   slau.opr3(az,d1);
   x[2]:=d1/d;
    for i:=1 to 3 do az[i,1]:=q[i,1];
    for i:=1 to 3 do az[i,2]:=q[i,2];
    for i:=1 to 3 do az[i,3]:=q[i,4];
   slau.opr3(az,d1);
   x[3]:=d1/d;
    form1.memo1.lines.clear;
    for i:=1 to 3 do form1.memo1.lines.add(floattostr(x[i]));


end;