Решение системы уравнений. Используем указатели
Пример 1.
Программа решает системы линейных уравнений не выше 70-го порядка и матричные уравнения A*X = B, где X,B - матрицы (не более 15 столбцов).
Элементы матриц можно вводить с клавиатуры или из текстового файла.
Используется метод главных элементов, описанный в учебнике
Б.Демидовича,И.Марона "Вычислительная математика" изд примерно 1960г.
В програме матрицы отображаются на одномерный массив.
--- Текст программы ----
Program SLAU_08;
type float = extended;
axtype = array [0..6001]of float;
tnum = array [0..101]of integer;
tbufx = array [0..501] of float;
pnum = ^tnum;
pbufx = ^tbufx;
Var A,X: ^AXtype;
NN,KK,dd,ii,jj : Integer; det: Extended; spos: char;
fnam: string; ttt: text;
{$I glavnelm.pas}
begin
writeln('Решаем систему уравнений A*X = B');
write('Введи N < 70 - число строк матрицы А '); readln(NN);
write('Введи K < 15 - число столбцов матриц X и B '); readln(KK);
if NN*(NN + KK) > 6000 then
begin
writeln('Слишком большие матрицы'); readln; exit;
end;
GetMem(A,NN*(NN+KK)*SizeOf(float));
GetMem(X,NN*KK*SizeOf(float)); spos:= 'T';
while not (spos in ['k','K','к','К','f','F','ф','Ф']) do
begin
write('Выбери способ ввода: K - клавиатура, F - файл -> ');
readln(spos);
if (spos in ['k','K','К','к']) then
begin
writeln('---- Вводим матрицу А -----');
for ii := 1 to NN do
for jj := 1 to NN do
begin write('Введи А[',ii:3,',',jj:3,'] -> ');
readln(A^[(ii-1)*(NN+KK)+jj-1]);
end;
writeln('---- Вводим матрицу B -----');
for ii := 1 to NN do
for jj := 1 to KK do
begin write('Введи B[',ii:3,',',jj:3,'] -> ');
readln(A^[(ii-1)*(nn+kk)+jj+NN-1]);
end;
end else if (spos in ['f','F','Ф','ф']) then
begin
writeln(
'Текстовый файл должен содержать матрицу А с "приклеенной" справа матрицей В');
writeln('Вначале - первая строка А и первая строка В, затем - вторая и т д');
writeln('Всего ',NN,' строк по ',NN+KK,' чисел в каждой строке,' );
writeln('Числа разделять пробелами или табуляц.');
write('Введите имя файла -> ');readln(fnam);
Assign(ttt, fnam);
{$I-}
reset(ttt);
{$I+}
if IOResult <> 0 then
begin
writeln('Файл '+fnam+'не найден'); readln; exit;
end; ii:=1;
while not eof(ttt) do
begin
for jj:=1 to nn+kk do read(ttt,A^[(ii-1)*(NN+KK)+jj-1]);
inc(ii);
end;
end else
begin
writeln('Введите k,K,к,К или f,F,ф,Ф');
end;
end;
writeln('---- Контроль -----');
for ii := 1 to NN do
begin
for jj := 1 to NN + KK do write (A^[(ii-1)*(NN+KK)+jj-1]:10:2);
writeln;
end;
glavnelem(a^,x^,nn,kk,det);
writeln('---- Результат -----');
for ii:=1 to nn do
begin
for jj:=1 to kk do
write(x^[(ii-1)*kk +jj-1]:8:2);
writeln;
end;
freemem(A,NN*(NN+KK)*SizeOf(float));
freemem(X,NN*KK*SizeOf(float));
readln;
end.
---- Текст процедуры glavnelem.pas ----
PROCEDURE GLAVNELEM(var a,x: AXtype; n,m: integer; var det: extended);
{ решение матричных уравнений A*X = B методом главных элементов }
var i,j,k,l,p,q,bufi : integer; buf,max,s: float;
num : pnum;
bufx: pbufx;
BEGIN
GetMem(num,(N+2)*SizeOf(integer));
GetMem(bufx,(N*M+1)*SizeOf(float));
buf := 0; for i:= 1 to n do for j:=1 to n do buf := buf + sqr(a[(i-1)*N + j - 1]);
for i:=1 to n do num^[i] := i; for k:=1 to n-1 do
begin {поиск главного элемента} max := abs(a[(k-1)*(n+m)+k-1]); p:=k; q:=k;
for i:=k to n do for j:=k to n do if abs(a[(i-1)*(n+m)+j-1]) > max then
begin p :=i; q := j; max := abs(a[(i-1)*(n+m)+j-1]);
end;
if p <> k then
for j:=1 to n+m do { перестановка строк k,p}
begin buf := a[(p-1)*(n+m)+j-1]; a[(p-1)*(n+m)+j-1] := a[(k-1)*(n+m)+j-1];
a[(k-1)*(n+m)+j-1] := buf;
end;
if q <> k then
for i:=1 to n do { перестановка столбцов k,q }
begin buf:= a[(i-1)*(n+m)+k-1]; a[(i-1)*(n+m)+k-1] := a[(i-1)*(n+m)+q-1];
a[(i-1)*(n+m)+q-1] := buf;
bufi := num^[k]; num^[k] := num^[q]; num^[q] := bufi;
end;
for i:= k+1 to n do
begin s:= a[(i-1)*(n+m)+k-1]/a[(k-1)*(n+m)+k-1]; for j:= k+1 to n+m do
a[(i-1)*(n+m)+j-1] := a[(i-1)*(n+m)+j-1] - s*a[(k-1)*(n+m)+j-1];
end;
end; { конец прямого хода }
buf:=1; for i:=1 to n do buf := buf*a[(i-1)*(n+m)+i-1]; det := buf;
for l:= 1 to m do { обратный ход }
begin bufx^[(n-1)*m+l-1] := a[(n-1)*(n+m)+n+l-1] / a[(n-1)*(n+m)+n-1];
for k:= n-1 downto 1 do
begin s := a[(k-1)*(n+m)+n+l-1];
for j:= n downto k+1 do s := s - a[(k-1)*(n+m)+j-1]*bufx^[(j-1)*m+l-1];
bufx^[(k-1)*m+l-1] := s/a[(k-1)*(n+m)+k-1];
end;
end; { на след. строке: восстановление исходных номеров неизвестных }
for l:=1 to m do for i:=1 to n do
x[(num^[i]-1)*m +l-1] := bufx^[(i-1)*m+l-1];
FreeMem(num,(N+2)*SizeOf(integer));
FreeMem(bufx,(N*M+1)*SizeOf(float));
END;
---- Текст файла с данными -----
2 1 1 1 1 6 18
1 2 1 1 1 6 18
1 1 2 1 1 6 18
1 1 1 2 1 6 18
1 1 1 1 2 6 18
(Здесь:
2 1 1 1 1 6 18 1 3
1 2 1 1 1 6 18 1 3
А = 1 1 2 1 1 В = 6 18 Решение Х = 1 3
1 1 1 2 1 6 18 1 3
1 1 1 1 2 6 18 1 3
)
