Новые сообщения · Правила  
  • Страница 1 из 1
  • 1
Решение СЛАУ с помощью метода Гаусса
Задача: дана система n-уравнений с n-неизвестными. Написать программу решения системы методом Гаусса, применяя только одномерные массивы.

Алгоритм:
1. С файла считывается число уравнений и расширенная матрица системы.
2. С помощью метода Гаусса находим корни.
3. Вычисленные корни записываем в файл, где находиться расширенная матрица системы.

program prak2;
{Программа для решения системы линейных алгебраических уравнений с помощью
метода Гаусса. Вычесления осуществляются в одномерных массивах.
Версия 1.0
22.03.2013
jester}
uses crt;
const n=20;
type Tmatrix=array [0..n*n-1] of real;
    Tfree_member=array [0..n-1] of real;
var number:byte;
    matrix:Tmatrix;
    x,free_member:Tfree_member;
    path:string;
//===========================
function Read_matrix_with_file(path:string; var number:byte):boolean;
var i,j,number_of_unknowns,number_of_equations:byte;
    outcome:integer;
    f:text;
begin
assign(f,path); {$I-} reset(f); {$I+} outcome:=IOResult; //проверка существования файла
if outcome<>0 then
    begin
     writeln('Неверный путь к файлу или такого файла не существует');
     Read_matrix_with_file:=false;
     exit;
    end;
readln(f,number);
if number>n then
 begin
  writeln('Неправильный ввод данных!');
  Read_matrix_with_file:=false;
  exit;
 end;
for i:=0 to number-1 do //считывание матрицы с файла
 begin
  for j:=0 to number-1 do read(f,matrix[i*number+j]);
  readln(f,free_member[i]);
 end;
close(f);
Read_matrix_with_file:=true;
end;
//===========================
procedure Transposition(var matrix:Tmatrix; var free_member:Tfree_member; i,number:byte);
var buf:real;
    buf_index,j:byte;
begin
if (i=number-1)and(matrix[i*number+i]=0)and(matrix[i*number+i]<>free_member[i]) then
 begin
  writeln('Система несовместна!');
  exit;
 end;
buf_index:=i+1;
while (matrix[i*number+i]=0)and(buf_index<=number)do
 begin
  for j:=0 to number-1 do //перестановка строк местами
   begin
    buf:=matrix[i*number+j]; //перестановка строк основной матрицы
    matrix[i*number+j]:=matrix[buf_index*number+j];
    matrix[buf_index*number+j]:=buf;
   end;
  buf:=free_member[i]; //перестановка свобных членов
  free_member[i]:=free_member[buf_index];
  free_member[buf_index]:=buf;
  inc(buf_index);
 end;
end;
//===========================
function Gauss(number:byte):boolean;
var i,j,t:byte;
    buf_accum,buf:real;
begin
for i:=0 to number-1 do //прямой ход
 begin
 //так как на ноль делить нельзя проверяем элемент
 if matrix[i*number+i]=0 then Transposition(matrix,free_member,i,number);
 for j:=i+1 to number-1 do
  begin
   buf:=matrix[j*number+i]/matrix[i*number+i];
   for t:=i to number-1 do matrix[j*number+t]:=matrix[j*number+t]-buf*matrix[i*number+t];
   free_member[j]:=free_member[j]-buf*free_member[i]; 
  end;
end;
//в ходе решения матрица может привестись к трапецивидной форме
//тогда она будет иметь безконечное число решений
if (matrix[i*number+i]=0)and(matrix[i*number+i]=free_member[i])then
 begin
  writeln('Система имеет безконечное число решений');
  Gauss:=false;
  exit;
 end;
for i:=number-1 downto 0 do //обратный ход
 begin
  buf_accum:=0;
  for j:=i+1 to number-1 do
   begin
    buf:=matrix[i*number+j]*x[j];
    buf_accum:=buf_accum+buf;
  end;
 x[i]:=(free_member[i]-buf_accum)/matrix[i*number+i];
end;
Gauss:=true; writeln('Решение системы алгебраических уравнений:');
for i:=0 to number-1 do writeln('x[',i,'] = ',x[i]:4:4); readkey;
end;
//===========================
procedure Write_answer_in_file(number:byte; path:string);
var i:byte;
 s:string;
 f:text;
begin
assign(f,path); append(f); writeln(f,' '); writeln(f,'Roots of equations:');
for i:=0 to number-1 do
 begin
  write(f,x[i]:4:4);
  write(f,' ');
 end;
close(f);
end;
//===========================
begin
clrscr;
writeln('В файле в первой строке должно содержаться число количества уравнений,');
writeln('далее с новой строки записана расширенная матрица системы (каждый элемент');
writeln('через пробел). Введите путь к файлу и его название с расширением .txt:');
readln(path);
if Read_matrix_with_file(path,number) then
 begin
  if Gauss(number) then Write_answer_in_file(number,path) else
   begin
    readkey;
    exit;
   end;
  end
else
 begin
  readkey;
  exit
 end
end.
1 | Автор: jester | 2013-03-23, 18:43 | Изменено: jester - Сб, 2013-03-23, 19:31   |  Репутация: [ + 3 ]
1 | Автор: jester | 2013-03-23, 18:43 | Изменено: jester - Сб, 2013-03-23, 19:31   |  Репутация: [ + 3 ]
  • Страница 1 из 1
  • 1
Поиск: