VPF::Определитель матрицы - Форум программистов

svarogik

Дата 30.9.2007, 18:24 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 159
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

Нужен алгоритм для нахождениея определителя матрицы, если не можете дать код на паскале, тогда пожалуйста не острите, там где я смотрел, код на С++, а мне очень нужно на паскале, в большой программе не достает ма-аленького элемента, но именно он все портит. Не могу придумать алгоритм для всех матриц, придумал для размерности >3, а на мелких матрицах не срабатывает. Да и на крупных глючит, я пытался из сумм основных диагоналей вычесть побочные

BaD_SeCt0R

Дата 30.9.2007, 18:33 (ссылка)

(нет голосов)

Загрузка ...

Lazy Coder

Профиль
Группа: Участник
Сообщений: 432
Регистрация: 9.10.2006
Где: Анапа

Репутация: нет
Всего: 18

Код


program determinant_program;
uses crt;
type determ=array[1..10,1..10] of integer;
procedure read_s(var a:determ; i,first_p:integer; j:integer);
  begin
    for j:=1 to first_p do
      begin
        write('Элемент[',i,',',j,']=');
        readln(a[i,j]);
      end;
  end;
procedure data(var first_p:integer; var a:determ; var error:string);
var i,j:integer;
  begin
    write('Порядок матрицы=');
    readln(first_p);
    if (first_p>0)
    then
      begin
        for i:=1 to first_p do
          begin
            read_s(a,i,first_p,j);
            writeln;
          end;
      end
    else
      begin
        error:='Определитель матрицы существует только если ее порядок больше 0';
      end;
  end;
procedure parse_s(var k,k1,n,j,i:integer; var s,s1:string; var a:determ);
  begin
    while (k<>0) do
      begin
        val(s,n,k);
        j:=j+1;
        if (k<>0)
        then
          begin
            s1:=copy(s,1,k-1);
            s:=copy(s,k+1,length(s)-k);
            val(s1,a[i,j],k1);
           end
         else
           begin
             a[i,j]:=n;
           end;
      end;
  end;
procedure reading(var a:determ; var power:integer; read_f:string);
var f:text;
    s,s1:string;
    k1,k,i,j,n:integer;
  begin
    assign(f,read_f);
    reset(f);
    readln(f,power);
    i:=0;
    while (not eof(f)) do
      begin
        readln(f,s);
        i:=i+1;
        j:=0;
        k:=1;
        parse_s(k,k1,n,j,i,s,s1,a);
      end;
    close(f);
  end;
procedure new_de(var j,coll,j1,power:integer; i:integer; var a:determ);
  begin
    while (j<=power) do
      begin
        j:=j+1;
        if (j<>coll)
        then
          begin
            j1:=j1+1;
            a[i,j1]:=a[i+1,j];
          end;
      end;
  end;
function de_val(a:determ; power,first_p,coll:integer ):integer;
var i,d,j,j1,znak:integer;
  begin
    if (coll<>0)
    then
      begin
        for i:=1 to power do
          begin
            j:=0;
            j1:=0;
            new_de(j,coll,j1,power,i,a);
          end;
      end;
    case power of
    1:de_val:=a[1,1];
    2:de_val:=a[2,2]*a[1,1]-a[1,2]*a[2,1];
    else
      begin
        d:=0;
        for i:=1 to power do
          begin
            if (((1+i) mod 2)=0)
            then
              begin
                znak:=1;
              end
            else
              begin
                znak:=-1;
              end;
            d:=d+znak*a[1,i]*de_val(a,power-1,first_p,i);
          end;
        de_val:=d;
      end;
    end;
  end;
procedure parse(var a:determ; var first_p:integer;var result:integer);
var power:integer;
  begin
    power:=first_p;
    result:=de_val(a,power,first_p,0);
  end;
procedure write_f(result:integer; write_f:string; a:determ);
var f:text;
    i,j:integer;
  begin
    if (write_f<>'')
    then
      begin
        assign(f,write_f);
        rewrite(f);
        writeln(f,result);
        close(f);
      end
    else
      begin
        writeln('determinant=',result);
        readln;
      end;
  end;
procedure print(result:integer);
  begin
    writeln('Определитель=',result);
    writeln('Нажмите enter для продолжения');
    readln;
  end;
var first_p,result:integer;
    read_file,write_file:string;
    error:string;
    a:determ;
begin
  clrscr;
  if (paramstr(1)<>''){если есть параметры командной строки}
  then{то}
    begin
      read_file:=paramstr(1);{считываемый файл - первый параметр}
      write_file:=paramstr(2);{выходной файл - второй параметр}
      reading(a,first_p,read_file);{считывание из файла}
      parse(a,first_p,result);{нахождение определителя}
      write_f(result,write_file,a);{запись в файл}
    end
  else{если нет, то}
    begin
      data(first_p,a,error);{запрос информации через пользовательский инерфейс}
      if (error='')
      then
        begin
          parse(a,first_p,result);{нахождение определителя}
          print(result);{запись в файл}
        end
      else
        begin
          writeln(error);
          writeln('Нажмите enter для продолжения');
          readln;
        end;
    end;
end.

Это сообщение отредактировал(а) BaD_SeCt0R - 30.9.2007, 18:36

--------------------

Кто владеет информацией - владеет миром. (С) Френсис Бэкон.

volvo877

Дата 30.9.2007, 18:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Цитата(svarogik @ 30.9.2007, 17:24

)

на мелких матрицах не срабатывает

Пример "мелкой матрицы, на которой не срабатывает" - в студию, потом (когда он будет проверен) получишь ссылку на программу...

sentry

Дата 30.9.2007, 18:40 (ссылка)

(нет голосов)

Загрузка ...

Code Monkey

Профиль
Группа: Участник
Сообщений: 133
Регистрация: 29.1.2007
Где: Москва

Репутация: нет
Всего: 10

Цитата(svarogik @ 30.9.2007, 19:54

)

придумал для размерности >3, а на мелких матрицах не срабатывает. Да и на крупных глючит

То есть вообще никогда не работает?

Цитата(svarogik @ 30.9.2007, 19:54

)

я пытался из сумм основных диагоналей вычесть побочные

Можно либо методом Гаусса привести матрицу к ступенчатому виду и перемножить диагональные элементы, либо сделать рекурсивно через разложение определителся порядка n на n определителей порядка n-1.

svarogik

Дата 1.10.2007, 09:54 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 159
Регистрация: 20.3.2006

Репутация: нет
Всего: нет

спасибо, будем надеятся что я разберусь,

tigrenokphp

Дата 6.3.2009, 05:01 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 6.3.2009

Репутация: нет
Всего: нет

Не подскажите, что нужно поменять чтоб вычисляла матрицу 22*22, ибо так выдаёт ошибку.

volvo877

Дата 6.3.2009, 11:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Лучше всего переписать программу полностью, без привязки к конкретной размерности (1000 раз говорили: пользуйтесь именованными константами!!! - Нет же, опять все привязывают к магическим числам. Вот вам результат - ешьте его теперь, ищите все вхождения, где что-то зависит от размерности, а что-то не зависит...)

Цитата(tigrenokphp @ 6.3.2009, 04:01

)

так выдаёт ошибку.

Кстати, неплохо было бы озвучивать ошибки, которые выдаются.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »