Помощь - Поиск - Пользователи - Календарь
Полная версия: РЕСЕНИЕ СЛАУ МЕТОДАМИ : Жордана Гаусса, ИТЕРАЦИЙ,Зейделя
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Dark_san
Доброго времени суток. Сижу делаю лабы.
Возникли вопросы.
1).
Const
n = 3; { Порядок системы уравнений }
m = 200; { Допустимое число итераций }
Type
row = Array [1 .. n] Of real;
matrix = Array[1 .. n] Of row;

{ Исходные данные: матрицы A и B (свободные члены) }
Const
A: matrix =
((0.75, -1.24, 1.56),
(-1.24, 0.18, -1.72),
(1.56, -1.72 ,0.79));



B: row =
(0.49, -0.57, 1.03);

Var
X: row; { Вектор решения для текущей итерации }
i, j: word;
S, Tolerance: real;

Procedure Seidel(Var A: matrix; Var B, X: row; n, m: word;
Tolerance: real);
Var
Y: row; { Вектор решения для предыдущей итерации }
T: real;
i, j, l: word;

Tolerance_stop_flag: boolean;
Const
k: word = 0;
Iteration_stop_flag: boolean = false;
Begin
For i := 1 To n Do Begin
Y[i] := 0; X[i] := 0
End;

Repeat
k := k + 1;
For i := 1 To n Do Begin
If A[i, i] = 0 Then Begin
l := i;
Repeat
l := l + 1;
If (A[l, i] = 0) and (l = n) Then Begin
WriteLn('Mistake of reduction of system for ', i, 'equation!'); Halt
End
Until A[l, i] <> 0;
T := B[i]; B[i] := B[l]; B[l] := T;

For j := 1 To n Do Begin
T := A[i, j]; A[i, j] := A[l, j]; A[l, j] := T
End;
WriteLn(i, 'and ', l, ' equations of system are rearranged !')
End;

S := 0;
For j := 1 To n Do
If j <> i Then S := S + A[i, j] * X[j];
X[i] := (B[i] - S) / A[i, i]
End;

i := 1;
Tolerance_stop_flag := False;
Repeat
If Abs(X[i] - Y[i]) > Tolerance
Then Tolerance_stop_flag := True
Else i := i + 1
Until (i = n) or Tolerance_stop_flag;

If not Tolerance_stop_flag Then Begin
Iteration_stop_flag := True;
Writeln('Number of iterations: ', k)
End
Else
For i := 1 To n Do Y[i] := X[i]
Until (k = m) or Iteration_stop_flag;

If not Iteration_stop_flag Then
WriteLn('The given number of iterations achieved! ', m)
End; {Seidel}

begin
WriteLn('Метод Зейделя'); WriteLn('A', 'B': 22);

For i := 1 To n Do Begin
For j := 1 To n Do Write(A[i, j]:4 :0);
WriteLn(B[i]:10 :0)
End;
Repeat
Write('Допустимая точность решения? '); ReadLn(Tolerance)
Until (Tolerance > 0) and (Tolerance < 1);

Seidel(A, B, X, n, m, Tolerance);

WriteLn('Result vector X ', 'Error B-AX': 25);
For i := 1 To n Do Begin
S := 0;
For j := 1 To n Do
S := S + A[i, j] * X[j];
WriteLn(X[i]:15:8, '':13, (B[i]-S):15 :8)
End;
ReadLn
end.

Почему при подсчетах выдает ошибку поинт флоатинг операшн?
п.с. Код взяла написанный ув. Volvo.
Вопрос номер два.
Программа Метод Жордана Гаусса
uses crt;
program solvgj2;

const maxr = 8;
maxc = 8;

type ary = array[1..maxr] of real;
arys = array[1..maxc] of real;
ary2s = array[1..maxr,1..maxc] of real;

ary2 = ary2s;
var y : ary;
coef,yy : arys;
a,b : ary2s;
n,m,i,j : integer;
first,
error : boolean;

external procedure cls;

procedure get_data(var a: ary2s;
var y: ary;
var n,m: integer);



var i,j : integer;

begin
writeln;
repeat
write('How many unknowns? ');
readln(m);
if first then first:=false else cls;
until m<maxc;
if m>1 then
begin
repeat
write('How many equations? ');
readln(n)
until n>=m;
for i:=1 to n do
begin
writeln('Equation',i:3);
for j:=1 to m do
begin
write(j:3,':');
read(a[i,j])
end;
write(',C:');
readln(y[i]) { clear line }
end; { i-loop }
writeln;
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:7:4,' ');
writeln(':',y[i]:7:4)
end;
writeln
end { if n>1 }
end; { procedure get_data }

procedure write_data;



var i : integer;

begin
for i:=1 to m do
write(coef[i]:9:5);
writeln
end; { write_data }

{external procedure square
( y : ary;
var a : ary2s;
var g : arys;
nrow,ncol : integer);}





begin { MAIN program }
first:=true;
cls;
writeln;
writeln('Best fit to simultaneous equations');
writeln('By Gauss-Jordan');
repeat
get_data(a,y,n,m);
if m>1 then
begin
square(a,y,b,yy,n,m);
gaussj(b,yy,coef,m,error);
if not error then write_data
end
until m<2
end.

Выдает ошибку на
external procedure cls;

и если убрать строку ( алгоритм рвется) но пишет что не хватает Begin.
Помогите пожалуйсто.
volvo
Цитата
Почему при подсчетах выдает ошибку поинт флоатинг операшн?
Потому что результаты очень велики, чтобы поместиться в Real... Замени везде Real на Double, увидишь, что за 200 итераций решение не было найдено. Оно для приведенной системы вообще существует?

Цитата
и если убрать строку ( алгоритм рвется) но пишет что не хватает Begin.
Откуда этот код? Что делает Cls? Вообще-то надо первую и вторую строки как минимум поменять местами, Program должна быть ПЕРВОЙ строкой программы в любом случае... А там у тебя еще и Square не будет хватать... Так что рассказывай, "откуда дровишки"?
Гость
Цитата(volvo @ 23.03.2010 0:51) *

Потому что результаты очень велики, чтобы поместиться в Real... Замени везде Real на Double, увидишь, что за 200 итераций решение не было найдено. Оно для приведенной системы вообще существует?

Откуда этот код? Что делает Cls? Вообще-то надо первую и вторую строки как минимум поменять местами, Program должна быть ПЕРВОЙ строкой программы в любом случае... А там у тебя еще и Square не будет хватать... Так что рассказывай, "откуда дровишки"?

Методом гаусса, краммера все щитает.
Возможно из за того, что метод приминим к матрицам с диагональным преобладанием.
Т.е модуль диагонального елемента должен быть больше суммы модулей двух других елементов
0.75, -1.24, 1.56
-1.24, 0.18, -1.72
1.56, -1.72 ,0.79
вот матрица, пытаюсь из нее сделать, что то хорошее.

Второй код написал знакомый по просьбе, но походу - на авось или из гугла.
Сижу краплю... sad.gif
Dark_san
писала я smile.gif)

Добавлено через 3 мин.
Да, и с double тоже самое. Тут походу дело в матрице.

Добавлено через 40 сек.
Потому, что когда программу писала в Си, в классах - тоже не считало.
П.с. Паскаль первый раз в глаза вижу, привыкла на си, а тут препод на тебе smile.gif)
where can i buy plaquenil withou
Viagra Generique Paypal
furosemide over the counter subs
Buy Sertraline No Prescription
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.