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

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > Вычислительная математика

Автор: Ura20007 22.11.2007, 16:13

Ребятки помогите доделать програмку.Нужно дописать нахождение определителя матрицы.
Код программы прикрепил

Автор: Ofer 23.11.2007, 23:30

Когда-то в инсте решал определитель методом Гауса. Кидаю этот метод, может он тебе поможет. Переделать под нужный размер матрицы не сложно.

Код


procedure TMath.GayssMethod;
var
  i,j,n,pos : Integer;
  mnow1, mnow2 : Real;
begin
  n := 1;
  WriteLn('Исходный массив');
  aViv(a);  {Процедура выводит матрицу на экран. Матрица а описана ранее, как глобальная}
  WriteLn('Ход работы');
  WriteLn;
  for j := 1 to 3 do
  begin
    for i := n to 3 do
    if a[i+1,j] <> 0 then
    begin
      mnow1 := a[j,j];
      mnow2 := a[i+1,j];
      for pos := 1 to 4 do
      begin
        a[i+1,pos] := a[i+1,pos]*mnow1 - a[j,pos]*mnow2;
        a[i+1,pos] := a[i+1,pos]/mnow1;
      end;
      aViv(a);
      ReadLn;
    end;
    n := n + 1;
  end;
  WriteLn('Определитель матрицы равен ',(a[1,1]*a[2,2]*a[3,3]*a[4,4]):8:8);
  ReadLn;
end;

Надеюсь это тебе пригодится smile

Автор: primax 25.11.2007, 02:58

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

Но это наверна не рационально)
П.С. Не читал код метода Гаусса (2 ночи всетаки), но эт случаем не треугольный метод (когда над\под главной диагональю одни нули)? Потомучто других методов для поиска детерминанта из вышки не помню.

Автор: Ofer 25.11.2007, 18:49

primax, это так и есть. Формируется треугольник из нулей под главной диагональю. Определитель можно еще найти понижением порядка, рекурентных соотношений, методом квадратных корней, присоедененной матрицы, методом елементарных преобразований...... smile

Гауса и два последних наиболее простые. ИМХО

Автор: BSE 25.11.2007, 22:42

var F, G: Text;
    I, J: Longint;
    N: Byte;
    Matrix, Buff: Array[1..100, 1..100] of Integer;

function PlusMin(I: Longint): Longint;
begin
   if I mod 2= 0 then PlusMin:= -1 else
      PlusMin:= 1;
end;

function Summ(Y: Byte): Longint;
var I, M, J, X1, X2: Byte;
    Summ2: Longint;
begin
   if (N- Y)= 1 then begin
      X1:=0;
      for I:= 1 to N do
         if Buff[I, N-1]=1 then
            if X1=0 then X1:= I else
               begin
                  X2:= I;
                  break;
               end;
      Summ:= Matrix[X1, N-1]*Matrix[X2, N]- Matrix[X1, N]*Matrix[X2, N-1];
   end else begin
      Summ2:=0;
      J:= 0;
      for I:=1 to N do begin
         if Buff[I, Y]<> 0 then begin
            Inc(J);
            for M:= Y+1 to N do Buff[I, M]:=0;
            Summ2:= Summ2+PlusMin(J)* Matrix[I, Y]* Summ(Y+1);
            for M:= Y+1 to N do Buff[I, M]:=1;
         end;
      end;
      Summ:= Summ2;
   end;
end;

begin
   Assign(F, 'InPut.txt');
   Assign(G, 'OutPut.txt');
   Reset(F);
   Rewrite(G);
   Read(F, N);
   for I:=1 to N do
      for J:=1 to N do begin
         Read(F, Matrix[I, J]);
         Buff[I, J]:= 1;
      end;
   Write(G, Summ(1));
   Close(F);
   Close(G);
end.