Помощь - Поиск - Пользователи - Календарь
Полная версия: РЕСЕНИЕ СЛАУ МЕТОДАМИ : Жордана Гаусса, ИТЕРАЦИЙ,Зейделя
Форум «Всё о Паскале» > 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
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.