imho.ws
IMHO.WS  

Вернуться   IMHO.WS > Компьютеры > Программирование
Опции темы
Старый 08.11.2005, 20:11     # 1
Yurij
Member
 
Аватар для Yurij
 
Регистрация: 30.05.2003
Адрес: Литва
Пол: Male
Сообщения: 329

Yurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царствеYurij Луч света в тёмном царстве
Нужны исходники по Pascal. Матрицы...

Привет всем!
Ищу вот такие исходники по Pascal:
Вычесление детерминанта, умножение матриц и вычечление уровнений по методу Гауса.
В сети видел несколько примеров... но они уж сложновато написаны... Может кто видел самые простые?
Спасибо!
Yurij вне форума  
Старый 09.11.2005, 10:18     # 2
Ghost
::VIP::
Звезда первого сезона
Молчун-2004
 
Аватар для Ghost
 
Регистрация: 24.08.2002
Сообщения: 1 575

Ghost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех ГуруGhost Отец (мать) всех Гуру
Yurij
Вот тебе исходник для вычисления определителя:
Код:
uses
  crt;

const
  n = 2;

type
  vector = array [1..32] of real;
  matrix = array [1..32] of vector;

var
  a: matrix;
  b, c: vector;
  i, j: byte;
  p: boolean;
  res: real;

procedure Determinant (x: matrix; size: byte; var Result: real);
var
  y: vector;
  i, j, k: byte;
  p: real;
begin
  Result := 0;
  for i := 1 to size do y[i] := 1;
  for i := 1 to pred (n) do begin
    if x[i, i] = 0 then begin
      k := succ (i);
      while (k <= size) and (x[k, i] = 0) do inc (k);
      if x[k, i] = 0 then exit;
      p := y[i]; y[i] := y[k]; y[k] := p; y[i] := -y[i];
      for j := i to size do begin
        p := x[i, j]; x[i, j] := x[k, j]; x[k, j] := p;
      end;
    end;
    p := x[i, i]; y[i] := y[i] * p;
    for j := i to size do x[i, j] := x[i, j] / p;
    for k := succ (i) to size do begin
      p := x[k, i];
      for j := i to size do x[k, j] := x[k, j] - p * x[i, j];
    end;
  end;
  Result := x[size, size];
  for i := 1 to pred (size) do Result := Result * y[i];
end;

procedure Gauss (x: matrix; y: vector; size: byte; var Result: vector; var isResult: boolean);
var
  i, j, k: byte;
  p: real;
begin
  isResult := False;
  for i := 1 to size do Result[i] := 0;
  for i := 1 to pred (n) do begin
    if x[i, i] = 0 then begin
      k := succ (i);
      while (k <= size) and (x[k, i] = 0) do inc (k);
      if x[k, i] <> 0 then begin
        p := y[i]; y[i] := y[k]; y[k] := p;
        for j := i to size do begin
          p := x[i, j]; x[i, j] := x[k, j]; x[k, j] := p;
        end;
      end;
    end;
    if x[i, i] <> 0 then begin
      p := x[i, i]; y[i] := y[i] / p;
      for j := i to size do x[i, j] := x[i, j] / p;
      for k := succ (i) to size do begin
        p := x[k, i]; y[k] := y[k] - p * y[i];
        for j := i to size do x[k, j] := x[k, j] - p * x[i, j];
      end;
    end;
  end;
  if (x[size, size] = 0) and (y[size] <> 0) then exit;
  if x[size, size] = 0 then Result[size] := 0
                       else Result[size] := y[size] / x[size, size];
  for i := pred (size) downto 1 do begin
    Result[i] := y[i];
    for j := succ (i) to size do
      Result[i] := Result[i] - x[i, j] * Result[j];
  end;
  isResult := True;
end;

begin
  clrscr;
  randomize;
  writeln ('start matrix:');
  for i := 1 to n do begin
    for j := 1 to n do begin
      a[i, j] := random(10);
      write (a[i, j]:8:2);
    end;
    b[i] := random(10);
    writeln (' | ', b[i]:8:2);
  end;
  Determinant (a, n, res);
  writeln ('determinant = ', res:8:2);
  Gauss (a, b, n, c, p);
  if not p then writeln ('net reshenija') else begin
    for i := 1 to n do writeln ('x[', i:2, '] = ', c[i]:8:2);
  end;
  readkey;
end.
Чуть попозжа напишу решение СЛУ методом Гаусса.

З.Ы. Добавил в код метод Гаусса. Кажись все работает...
__________________
Действовать надо тупо и это лучшее доказательство нашей чистоты и силы!

Последний раз редактировалось Ghost; 09.11.2005 в 10:49. Причина: склероZzz...
Ghost вне форума  

Опции темы

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

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

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


Часовой пояс GMT +4, время: 18:48.




Powered by vBulletin® Version 3.8.5
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.