Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.12.2007, 22:58   #1
FeT
 
Регистрация: 01.12.2007
Сообщений: 4
По умолчанию Разработка программ с использованием процедур(Unit)

Вообще не всасываю как это делать... Помогите плз!
Найти:
а)Корни из системы уравнений
5.3X1 + 2.1X2 - 3.2X3 - 1.25X4 + 0.5X5 =-3.05
-0.25X1 + 7.1X2 + 4.3X3 - 0.7X4 - 1.1X5 =0.15
1.35X1 - 2.5X2 + 6.83X3 + 0.35X4 + 1.8X5 =-1.7
2.25X1 + 0.9X2 - 4.3X3 + 5.25X4 - 0.83X5 =4.1
-0.5X1 - 1.7X2 + 3.7X3 - 1.25X4 + 8.9X5 =2

б)Упорядочить найденные корни по убыванию их значений;

в)(найти) корень, минимально отличающийся от последнего элемента первого столбца матрицы коэффициентов.
FeT вне форума Ответить с цитированием
Старый 02.12.2007, 08:23   #2
puporev
Старожил
 
Регистрация: 13.10.2007
Сообщений: 2,740
По умолчанию

1.Решить систему линейных уравнений (СЛАУ) одним из известных сособов. (методы Гаусса, Зейделя, Крамера, обратной матрицы и т.д.
2 и 3 по сравнению с первым ерунда.
puporev вне форума Ответить с цитированием
Старый 02.12.2007, 09:22   #3
lix
 
Регистрация: 02.12.2007
Сообщений: 8
По умолчанию

Цитата:
Сообщение от puporev Посмотреть сообщение
1.Решить систему линейных уравнений (СЛАУ) одним из известных сособов. (методы Гаусса, Зейделя, Крамера, обратной матрицы и т.д.
2 и 3 по сравнению с первым ерунда.
Реально - методом гаусса реши на бумажке - потом напиши блок-схему и напиши код алгоритма - проще простого ведь. . Кстати если хочешь могу помочь
lix вне форума Ответить с цитированием
Старый 02.12.2007, 11:42   #4
FeT
 
Регистрация: 01.12.2007
Сообщений: 4
По умолчанию

решить на бумажке это действительно не сложно, а вот разработать алгоритм... Я просто не понимаю как это сделать!
FeT вне форума Ответить с цитированием
Старый 02.12.2007, 19:11   #5
Nexx
Пользователь
 
Регистрация: 25.09.2007
Сообщений: 28
По умолчанию

зачем кста две одинаковые темы создал?)
Nexx вне форума Ответить с цитированием
Старый 02.12.2007, 20:42   #6
necky
Пользователь
 
Аватар для necky
 
Регистрация: 11.08.2007
Сообщений: 69
По умолчанию

Код:
const
  Comments: boolean = false; { нужно ли печатать пошаговые рез-ты расчета }
  Eps = 0.00001;        { Точность вычислений }
  n_max = 4;            { Кол-во ур-й и неизвестных }
  const_AnB: array[1..n_max,1..n_max+1] of double =
 (( -8,   2,  17,  -5, -119.97),
 { -8*X[1] + 2*X[2] + 17*X[3] - 5*X[4] = -119.97  и т.д. ... }
  (  4, -22,   6,   5,   55.73),
  ( 15,   3,  -5,  -5,   18.77),
  ( -4,  -4,   5,  14,  -79.42));
{ Описание типов матрицы уравнеиний и массива найденных Х }
Type TMatr = array[1..n_max,1..n_max+1] of double;
Type TXMarr = array[1..n_max] of double;
 
procedure PrintX(const X: TXMarr; n: byte; cnt: word);
{ Печатает найденные Х }
var
  k,       { Позиция заданного корня в массиве }
  i: byte; { Номер текущего корня для вывода }
begin
  if n = 0 then
    exit;
  k:=low(X);
  if cnt = 0 then
    begin
      write(' N       x1');
      for i:=2 to n do
        write('         x',i);
      writeln;
    end;
  write(cnt:2);
  for i:=1 to n do
    begin
      Write('   ',X[k]:3:5);
      inc(k);
    end;
  writeln;
{
  При решении систем, с большим кол-вом неизвестных, возможно,
  прийдется переделать эту процедуру для корректного вывода
  всех решений.
}
end; { PrintX }
 
procedure PrintMatr(var AnB: TMatr; n: byte);
{ Печатает заданную матрицу }
var
  i,j: byte;
begin
  for i:=1 to n do
    begin
      for j:=1 to n+1 do
        write(AnB[i,j]:3:5,'   ');
      writeln;
    end;
  writeln;
{
  При решении систем, с большим кол-вом неизвестных, возможно,
  прийдется переделать эту процедуру для корректного вывода
  всех решений.
}
end; { PrintMatr }
 
function Normalize(var AnB: TMatr; n: byte): byte;
{
 Располагает на главной диагонали наибольшие элементы в столбцах
 Если один из них равен нулю,то систему решить не получится ...
 Возвращает 0 если систему заданными методами решить не получится,
 1 - с-му можно решить только методом Гаусса
 2 - с-му можно решать любым методом
}
var
  max: double; { Переменная для поиска макс. эл-та }
  imax: byte;  { Переменная для поиска макс. эл-та }
  tmp: double; { Переменная для обмена элементов }
  i,j: byte;   { Счетчики циклов }
begin
  Normalize:=2;
  for j:=1 to n do
    begin
      max:=Abs(AnB[1,j]);
      imax:=1;
      for i:=2 to n do
        if Abs(AnB[i,j]) > max then
          begin
            max:=Abs(AnB[i,j]);
            imax:=i;
          end;
      if max < Eps then
        begin
          Normalize:=0;
          Writeln('Error: a[i,i]=0!');
          exit;
        end
      else
        if j <> imax then
          for i:=1 to n+1 do
            begin
              tmp:=AnB[j,i];
              AnB[j,i]:=AnB[imax,i];
              AnB[imax,i]:=tmp;
            end;
    end;
  for i:=1 to n do
    begin
      tmp:=0;
      for j:=1 to n do
        if i <> j then
          tmp:=tmp+Abs(AnB[i,j]);
      if Abs(AnB[i,i]) < tmp then
        Normalize:=1;
    end;
end; { Normalize }
 
procedure Metod1(const Matr; n: byte);
var
  k    : byte;
  M_   : TMatr absolute Matr;
  AnB  : TMatr;
  X,M  : TXMarr;
function Calc(k: byte): boolean;
var
  i,j  : byte;
begin
  Calc:= true;
  for i:=k+1 to n do
    begin
      M[i]:= AnB[i,k]/AnB[k,k];
      if M[i] > 1 then
        begin
          Calc:= false;
          exit;
        end;
    end;
 
  for i:=k+1 to n do
    for j:=k to n+1 do
      AnB[i,j]:=AnB[i,j]-M[i]*AnB[k,j];
 
  if Comments then
    PrintMatr(AnB,n);
end; { Calc }
function Summ(j: byte): double;
var
  i : byte;
  res : double;
begin
  res:=AnB[j,n+1];
  for i:=n downto j+1 do
    res:=res - AnB[j,i]*X[i];
  Summ:=res;
end; { Summ }
begin
  Writeln('Метод Гаусса:');
  AnB:=M_;
  if Normalize(AnB,n) = 0 then
    begin
      writeln('Error: Невозможно решить систему уравнений!');
      exit;
    end;
 
  for k:=1 to n-1 do
    if not Calc(k) then
      begin
        Writeln('Error: Невыполняется условие | a^(k-1)_[k,k] | >= | a^(k-1)_[i,k] | !');
        exit;
      end;
 
  X[n]:=AnB[n,n+1]/AnB[n,n];
  for k:=n-1 downto 1 do
    X[k]:=Summ(k)/AnB[k,k];
 
  PrintX(X,n,0);
  Writeln;
end; { Metod1 }
Советовать можно лишь в деле, в котором сам собираешься участвовать.
necky вне форума Ответить с цитированием
Старый 02.12.2007, 20:42   #7
necky
Пользователь
 
Аватар для necky
 
Регистрация: 11.08.2007
Сообщений: 69
По умолчанию

Код:
procedure Metod2(const Matr; n: byte);
var
  M_   : TMatr absolute Matr;
  AnB  : TMatr;
  X    : TXMarr;
  i,j: byte;
  tmp: double;
  delta: double;
  cnt: word;
function Summ(i: byte): double;
var
  j: byte;
  res: double;
begin
  res:=AnB[i,n+1];
  for j:=1 to n do
    if i <> j then
      res:=res-AnB[i,j]*X[j];
  Summ:=res;
end; { Summ }
begin
  writeln('Метод Гаусса-Зейделя:');
  AnB:=M_;
  For i:=1 to n do
    X[i]:=0;
  if Normalize(AnB,n) <> 2 then
    begin
      writeln('Error: !');
      exit;
    end;
  delta:=1;
  cnt:=0;
  while delta > Eps do
    begin
      if Comments then
        PrintX(X,n,cnt);
      delta:=0;
      for i:=1 to n do
        begin
          tmp:=Summ(i)/AnB[i,i];
          if delta < Abs(tmp-X[i]) then
            delta:=Abs(tmp-X[i]);
          X[i]:=tmp;
        end;
      inc(cnt);
    end;
 
  PrintX(X,n,cnt);
 
  writeln('Заданная точность вычислений достигнута на ',cnt,' шаге.');
  Writeln;
end; { Metod2 }
 
begin
  Writeln(#10,'Численное решение систем линейных алгебраических уравнений:',#10);
  Metod1(const_AnB,n_max);
  Writeln('Press Enter to continue');
  readln;
  Metod2(const_AnB,n_max);
  Writeln('Press Enter if you wanna DOS ;)');
  readln;
end.
Советовать можно лишь в деле, в котором сам собираешься участвовать.
necky вне форума Ответить с цитированием
Старый 04.12.2007, 17:49   #8
FeT
 
Регистрация: 01.12.2007
Сообщений: 4
По умолчанию

спасибо за помощь!
FeT вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разработка программ с использованием функций. Табулирование функции одного и двух переменных кася Паскаль, Turbo Pascal, PascalABC.NET 5 07.05.2008 20:11
Организация программ с использованием процедур....Pascal flexo_77 Помощь студентам 1 19.12.2007 14:06
Разработка программ с использованием процедур(Unit) FeT Помощь студентам 3 02.12.2007 20:42