Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Технологии > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 02.05.2008, 01:34   #1
Snake_ua
Форумчанин
 
Регистрация: 25.09.2007
Сообщений: 66
Репутация: 8
По умолчанию Определитель матрицы

Здравствуйте и с прошедшими праздниками всех. Помогите мне пожалуйста. Я пишу программу, для нахождения определителя матрицы. Идея такова: привести матрицу к треугольному виду и переумножить все элементы главной диагонали. Но прежде надо привести к треугольному виду. Ну, в принцыпе это и не выходит. Посмотрите пожалуйста, заранее благодарен.
Вложения
Тип файла: rar Projects.rar (7.5 Кб, 16 просмотров)
Snake_ua вне форума   Ответить с цитированием
Старый 02.05.2008, 01:59   #2
eoln
Профессионал
 
Аватар для eoln
 
Регистрация: 26.04.2008
Сообщений: 2,691
Репутация: 2215

icq: 421277094
По умолчанию

Извиняюсь, что на паскале, но вот отрывок из метода Гауса по приведению квадратной матрицы к треугольному виду, однако система уравнений должна быть разрешима
Код:

const n=3;
var 
  mas0, mas, mas2: array[1..n, 1..n] of real;
  a, b, k, i, j: integer;
procedure treyg;
begin
for k:=1 to n do begin
    for j:=k to n do begin
        for i:=k+1 to n do begin
            mas[i, j]:=mas2[i, j]*mas2[k, k]/mas2[i, k]-mas2[k, j];
        end;
    end;
    mas2:=mas;
    writeln;
    for a:=1 to n do begin
        for b:=1 to n do write(mas[a,b]:6:2);
        writeln
    end;
end;
end;
begin    
    mas[1,1]:=1; mas[1,2]:=1; mas[1,3]:=1;
    mas[2,1]:=2; mas[2,2]:=3; mas[2,3]:=3;
    mas[3,1]:=1; mas[3,2]:=3; mas[3,3]:=1; {testovay matrica}
    {for i:=1 to n do for j:=1 to n do begin
        write('mas[',i,',',j,']='); readln(mas[i,j])
    end;}
    for i:=1 to n do begin
        for j:=1 to n do write(mas[i,j]:6:2);
        writeln
    end;
    mas0:=mas;
    mas2:=mas;
    treyg;
    readln;
end.

eoln вне форума   Ответить с цитированием
Старый 02.05.2008, 02:18   #3
eoln
Профессионал
 
Аватар для eoln
 
Регистрация: 26.04.2008
Сообщений: 2,691
Репутация: 2215

icq: 421277094
По умолчанию

Ну вот, поковырялся в своих старых задачах по ЧМ и нашёл решение системы уравнений методом Гауса с учётом ошибки деления на ноль.
Немного его упростите и получится самое то
Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Const n=3;
Var MAS,MAS2:array[1..n,1..n+1]of real;
    X:array[1..n]of real;

//Процедура перестановки 2-х уравнений в системе
Procedure swapij(a,b:byte);
Var i:byte;
    j:real;
Begin
    for i:=1 to n+1 do begin
        j:=mas[a,i];
        mas[a,i]:=mas[b,i];
        mas[b,i]:=j
    end
End;

//функция проверки на разрешимость СЛУ
Function normal:boolean;
Var i,d,swap1,swap2:byte;
Begin
    result:=true;swap1:=0;swap2:=0;
    for d:=1 to n do if mas[d,d]=0 then begin
        result:=false;
        for i:=1 to n do if (mas[i,d]<>0)and(mas[d,i]<>0) then begin
            result:=true;
            swap1:=i;
            swap2:=d;
            swapij(swap1,swap2);
            break
        end;
        if swap1*swap2=0 then break;
    end;
End;

Var i,j,k:byte;
BEGIN
//***************************************Ввод матрицы
  mas[1,1]:=0.60;mas[1,2]:=0.73;mas[1,3]:=-0.37;mas[1,4]:=1.63;
  mas[2,1]:=-1.62;mas[2,2]:=3.51;mas[2,3]:=-0.78;mas[2,4]:=2.57;
  mas[3,1]:=3.11;mas[3,2]:=-1.66;mas[3,3]:=-0.60;mas[3,4]:=-0.92;
//********************Тестовая матрица, ответ (1,2,-2)
//Эта матрица нужна на этапе проверки
  {mas[1,1]:=1;mas[1,2]:=1;mas[1,3]:=2;mas[1,4]:=-1;
  mas[2,1]:=2;mas[2,2]:=-1;mas[2,3]:=2;mas[2,4]:=-4;
  mas[3,1]:=4;mas[3,2]:=1;mas[3,3]:=4;mas[3,4]:=-2;}
//*******************************Вывод старой матрицы
  for i:=1 to n do begin
    for j:=1 to n+1 do write(mas[i,j]:8:4,' ');
    writeln
  end;
  writeln;
//***************Сделать главную диагональ не нулевой
  if not normal then writeln('NOT NORMAL');
//**********************************Решение по Гауссу
  mas2:=mas;
  for k:=2 to n do begin
    for i:=k to n do
      for j:=k-1 to n+1 do
        mas2[i,j]:=mas[i,j]/mas[i,k-1]*mas[k-1,k-1]-mas[k-1,j];
  mas:=mas2;
  end;
//**************************Вывод приведённой матрицы
//Ну как раз треугольной
  for i:=1 to n do begin
    for j:=1 to n+1 do write(mas[i,j]:6:2,' ');
    writeln
  end;
  writeln;
//**********************************Вычисление корней
  for i:=n downto 1 do begin
    x[i]:=mas[i,n+1];
    for j:=n downto i+1 do begin
      x[i]:=x[i]-mas[i,j]*x[j];
    end;
    x[i]:=x[i]/mas[i,i];
  end;
//***************************************Вывод корней
  for i:=1 to n do
    writeln('X',i,' = ',X[i]:0:2);
  readln;
END.

Только учтите, что если мы имеем дело с нахождением определителя матрицы, то при перестановке строк в процедуре swapij необходимо учитывать смену знака при соответствующей операции
Пример для пояснения
|1, 2|
| | = 1*4-2*3 = -2
|3, 4|
теперь поменяем строки
|3, 4|
| | = 3*2-4*1 = 2
|1, 2|
Таким образом надо знать сколько ра вызывалась процедура swapij (поставить туда счётчик), а затем определитель матричы умножить на (-1) столько число раз, чему равен счётчик
eoln вне форума   Ответить с цитированием
Старый 02.05.2008, 02:44   #4
Snake_ua
Форумчанин
 
Регистрация: 25.09.2007
Сообщений: 66
Репутация: 8
По умолчанию

Спаибо, но а мой код подправить как-то можно, ато что-то немного сложно разобратся...
Snake_ua вне форума   Ответить с цитированием
Старый 02.05.2008, 03:07   #5
eoln
Профессионал
 
Аватар для eoln
 
Регистрация: 26.04.2008
Сообщений: 2,691
Репутация: 2215

icq: 421277094
По умолчанию

Код:

program Project1;
  
{$APPTYPE CONSOLE}   
  
uses   
  SysUtils;   
  
Const n=3;   
Var MAS,MAS2:array[1..n,1..n]of real;
    SwapCount: byte;
  
//Процедура перестановки 2-х уравнений в системе   
Procedure swapij(a,b:byte);   
Var i:byte;   
    j:real;   
Begin
    inc(SwapCount);
    for i:=1 to n do begin
        j:=mas[a,i];   
        mas[a,i]:=mas[b,i];   
        mas[b,i]:=j   
    end   
End;   
  
//функция проверки на приводимость матрицы   
Function normal:boolean;   
Var i,d,swap1,swap2:byte;   
Begin   
    result:=true;swap1:=0;swap2:=0;   
    for d:=1 to n do if mas[d,d]=0 then begin   
        result:=false;   
        for i:=1 to n do if (mas[i,d]<>0)and(mas[d,i]<>0) then begin   
            result:=true;   
            swap1:=i;   
            swap2:=d;   
            swapij(swap1,swap2);   
            break   
        end;   
        if swap1*swap2=0 then break;   
    end;   
End;   
  
Var i,j,k:byte;   
BEGIN
  SwapCount:=0;
//***************************************Ввод матрицы
  mas[1,1]:=1;mas[1,2]:=1;mas[1,3]:=2;
  mas[2,1]:=2;mas[2,2]:=-1;mas[2,3]:=2; 
  mas[3,1]:=4;mas[3,2]:=1;mas[3,3]:=4;   
//*******************************Вывод старой матрицы   
  for i:=1 to n do begin
    for j:=1 to n do write(mas[i,j]:8:4,' ');
    writeln   
  end;   
  writeln;   
//***************Сделать главную диагональ не нулевой   
  if not normal then writeln('NOT NORMAL');
//**********************************Приводим к треугольному виду   
  mas2:=mas;   
  for k:=2 to n do begin   
    for i:=k to n do   
      for j:=k-1 to n do
        mas2[i,j]:=mas[i,j]/mas[i,k-1]*mas[k-1,k-1]-mas[k-1,j];
  mas:=mas2;
  end;
//**************************Вывод приведённой матрицы   
//Ну как раз треугольной   
  for i:=1 to n do begin
    for j:=1 to n do write(mas[i,j]:6:2,' ');   
    writeln   
  end;
  if SwapCount mod 2 = 1 then write('Opredelitel'' ymno*aem na -1'); 
  readln 
END.

Элементы матрицы можно изменить
Прошлый код странен и не верно производит деление (ошибка в алгоритме)

Последний раз редактировалось eoln; 02.05.2008 в 03:11.
eoln вне форума   Ответить с цитированием
Старый 02.05.2008, 03:32   #6
Snake_ua
Форумчанин
 
Регистрация: 25.09.2007
Сообщений: 66
Репутация: 8
По умолчанию

я даже чуток не то загрузил
Вложения
Тип файла: rar Projects.rar (7.3 Кб, 19 просмотров)
Snake_ua вне форума   Ответить с цитированием
Старый 10.02.2010, 11:40   #7
sllh_111
Форумчанин
 
Регистрация: 10.02.2010
Сообщений: 137
Репутация: 10
По умолчанию

раз уж тут начали обсуждать определитель, то вот:

const n=5;
type matr=array[1..n,1..n] of longint;
var a,b:matr;
i,j,dt:longint;
procedure PrintMatr(m:matr;n:integer);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do
write(m[i,j]:3);
writeln;
end;
end;
procedure GetMatr(a:matr; var b:matr; m,i,j:integer);
var ki,kj,di,dj:integer;
begin
di:=0;
for ki:=1 to m-1 do
begin
if (ki=i) then di:=1;
dj:=0;
for kj:=1 to m-1 do
begin
if (kj=j) then dj:=1;
b[ki,kj]:=a[ki+di,kj+dj];
end;
end;
end;
Function Determinant(a:matr;n:integer):longi nt;
var i,j,d,k:longint;
b:matr;
begin
d:=0; k:=1;
if (n<1) then
begin
writeln('Determinant: Cann''t run. N=',n); halt;
end;
if (n=1)
then d:=a[1,1]
else if (n=2)
then d:=a[1,1]*a[2,2]-a[2,1]*a[1,2]
else { n>2 }
for i:=1 to n do
begin
GetMatr(a,b,n,i,1);
d:=d+k*a[i,1]*Determinant(b,n-1);
k:=-k;
end;
Determinant:=d;
end;
begin
randomize;
for i:=1 to n do
for j:=1 to n do
a[i,j]:=random(5);
PrintMatr(a,n);
dt:=Determinant(a,n);
writeln('=========');
writeln('Determinant=',dt);
end.

только:
1. для 4, 5, 6, 7 мерной матрицы не хватает динамической памяти,
если кто поможет буду очень благодарен!
2. надо чтобы вся программа работала от одной процедуры(ну или хотябы эта процедура обращалась к процедурам и функции. это надо мне для создания меню).
sllh_111 вне форума   Ответить с цитированием
Старый 10.02.2010, 11:44   #8
sllh_111
Форумчанин
 
Регистрация: 10.02.2010
Сообщений: 137
Репутация: 10
По умолчанию

ну вобщем нужна помощь с 1 и 2.
sllh_111 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Матрицы FatalX Помощь студентам 21 17.04.2009 22:50
матрицы chelsi Паскаль 13 25.04.2008 10:07
матрицы Ensoph Помощь студентам 1 24.10.2007 09:38


03:07.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru