17.11.2018, 17:10 [+3 UTC]
в нашей команде: 3 112 чел. | участники онлайн: 13 (рекорд: 17)

:: РЕГИСТРАЦИЯ

:: задать вопрос

:: все разделы

:: правила

:: новости

:: участники

:: доска почёта

:: форум

:: блоги

:: поиск

:: статистика

:: наш журнал

:: наши встречи

:: наша галерея

:: отзывы о нас

:: поддержка

:: руководство

Версия системы:
7.55 (06.11.2018)

Общие новости:
24.09.2018, 16:49

Форум:
08.11.2018, 13:36

Последний вопрос:
17.11.2018, 15:12

Последний ответ:
17.11.2018, 17:02

Последняя рассылка:
17.11.2018, 16:46

Писем в очереди:
0

Мы в соцсетях:

Наша кнопка:

RFpro.ru - здесь вам помогут!

Отзывы о нас:
30.05.2017, 17:01 »
Tati77
Спасибо Андрею Владимировичу за быстрый и правильный ответ! [вопрос № 191070, ответ № 275046]
15.02.2010, 11:46 »
Мироненко Николай Николаевич
Спасибо большое! По поводу старины 8-ой версии - я пока что поработаю в этой, тем более сильных различий в этих версий я не заметил(9.01 уже видел). smile [вопрос № 176645, ответ № 259440]

РАЗДЕЛ • Pascal / Delphi / Lazarus

Создание программ на языках Pascal, Delphi и Lazarus.

[администратор рассылки: Зенченко Константин Николаевич (Модератор)]

Лучшие эксперты в этом разделе

Зенченко Константин Николаевич
Статус: Модератор
Рейтинг: 684
Степанов Иван /REDDS
Статус: 4-й класс
Рейтинг: 26
Асмик Гаряка
Статус: Советник
Рейтинг: 6

Перейти к консультации №:
 

Консультация онлайн # 172614
Раздел: • Pascal / Delphi / Lazarus
Автор вопроса: LanK
Отправлена: 25.09.2009, 14:16
Поступило ответов: 1

Здравствуйте, уважаемые Эксперты!

Срочно нужна Ваша помощь!

Для решения одной из моих задач мне нужно найти решение системы линейных уравнений методом Гаусса.

Поискав в интернете нашел _один_ распространенный алгоритм (приведу его ниже).
НО! Он работает только для матриц с ненулевыми значениями.

Я точно знаю, что методом Гаусса можно решить и с нулевыми, но такого примера не нашел.

Если у кого есть прошу поделитесь, пожалуйста. (Матрица n*n +значения). Т около 1000. приведенный ниже алгоритм для не нулевых значений нормально отрабатывается за 3 секунды.

P.S. Это не для курсовой и т.д.

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls;

const MaxDimension = 10;

type

  Vector = array[1..MaxDimension] of Double;
  Matrix = array[1..MaxDimension] of Vector;

  TForm3 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
  var a: Matrix;
      b,x: Vector;
      h: Double;
      i,j,k,n:integer;
begin
  //Ввод данных
  //Размерность системы
  n := StrToIntDef(Text, StringGrid1.ColCount);
  //Коэффициенты
  for j := 0 to n - 1 do
    for i := 0 to n - 1 do
      a[i + 1, j + 1] := StrToFloatDef(StringGrid1.Cells[j, i], 0);
  //Правая часть уравнения
  for I := 0 to n - 1 do b[i + 1] := StrToFloatDef(StringGrid2.Cells[0, i], 0);
  //Прямой ход - исключение переменных
  for i:=1 to n-1 do
    for j:=i+1 to n do
    begin
      a[j,i]:=-a[j,i]/a[i,i];
      for k:=i+1 to n do
        a[j,k]:=a[j,k]+a[j,i]*a[i,k];
        b[j]:=b[j]+a[j,i]*b[i]
    end;
    x[n]:=b[n]/a[n,n]; //Деление на ноль  smile  
    //Обратный ход - нахождение корней
    for i:=n-1 downto 1 do
    begin
      h:=b[i];
      for j:=i+1 to n do h:=h-x[j]*a[i,j];
      x[i]:=h/a[i,i]
    end;
    //Вывод результата
    for i:=1 to n do ListBox1.Items.Append('x(' + IntToStr(i) + ')=' + FloatToStr(x[i]));
end;

procedure TForm3.Edit1Change(Sender: TObject);
begin
  with StringGrid1, Edit1 do
  begin
    ColCount := StrToIntDef(Text, 3);
    RowCount := StrToIntDef(Text, 3);
  end;
  with StringGrid2, Edit1 do
    RowCount := StrToIntDef(Text, 3)
end;

procedure TForm3.FormCreate(Sender: TObject);
  var i, j: integer;
begin
  //Заполнить коэф уравнения
  Randomize;
  for I := 0 to StrToIntDef(Text, StringGrid1.ColCount) - 1 do
    for J := 0 to StrToIntDef(Text, StringGrid1.RowCount) - 1 do
      StringGrid1.Cells[I, J] := IntToStr(Random(100));
  for I := 0 to StrToIntDef(Text, StringGrid2.RowCount) - 1 do
    StringGrid2.Cells[0, I] := IntToStr(Random(100))
end;

end.

Состояние: Консультация закрыта

Ответ # 254815 от Сергей Бендер (Профессионал)

Здравствуйте, LanK.


1) Непонятно, почему у тебя написано "Деление на ноль" в строчке с делением на a[n,n]. Оно, как правило, должно происходить раньше, в цикле при делении на a[i,i]

2) Напутано с алгоритмом - правильного ответа быть не должно. После
a[j,i]:=-a[j,i]/a[i,i];
надо делать такое же деление для b
b[j]:=-b[i]/a[i,i];

А строчка
b[j]:=b[j]+a[j,i]*b[i]
должна, во первых, находиться в цикле (у тебя нет begin end), во вторых, просчитывать k-й (а не j-й) элемент, т.е.:
b[k]:=b[k]+a[j,i]*b[k]

3) Обратный ход вполне можно делать от n:
for i:=n downto 1 do
а строчку
x[n]:=b[n]/a[n,n];
преспокойно стирать. Избыточна.

4) Теперь о нулевых диагональных элементах. Это нужен алгоритм с выбором столбцов. Собственно никакого особого алгоритма тут нет. Просто у системы можно без нарушения эквивалентности менять местами столбцы. Главное при это помнить какие столбцы переставлены.

Т.е. перед главным делением
a[j,i]:=-a[j,i]/a[i,i];
надо проверить a[i,i] на равнество нулю и, если да, то найти в строке какой-нибудь (например, первый) ненулевой. (Если все нули значит система недоопределени и не имеет единственного решения.) Это можно сделать сразу
m:=i;
while (a[i,m]<>0) and (m<=n) do inc(m);
if m>n then ... // все нули
Потом цикл по этим столбцам (от начала, а не от i)
for k:=1 to n do
begin
/// меняем местами a[i,k] и a[m,k]
end;

Останется только запоминть, какие элементы поменял. Это можно держать в массиве вроде
ind:array[1..n] of integer;
Перед прямым ходом надо его заполнить
for i:=1 to n do ind[i]:=i;
А результата выводить не как x[i], а как x[ind[i]].
(В принципе, может быть в Делфе уже есть какая-нибудь удобная штука для этого. Не помню.)

Удачи!


Консультировал: Сергей Бендер (Профессионал)
Дата отправки: 28.09.2009, 21:34

5
спасибо
-----
Дата оценки: 30.09.2009, 08:55

Рейтинг ответа:

0

[подробно]

Сообщение
модераторам

Отправлять сообщения
модераторам могут
только участники портала.
ВОЙТИ НА ПОРТАЛ »
регистрация »

Мини-форум консультации № 172614

Посетитель

ID: 5994

# 1

= общий = | 25.09.2009, 14:19 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Т около 1000
забыл переключить раскладку естественно - N около 1000.
P.S. Просьба помещайте решение в тэгах код - в приложении переносы строк срезаются, "дешифровать" потом практически невозможно.


Посетитель

ID: 5994

# 2

= общий = | 29.09.2009, 10:43 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Сергей Бендер:
Сергей, очень неплохо Вы всё расписали.
Приведите, пожалуйста, рабочий код (в тегах code).
А то мыслей в Вашем ответе много, при "сборке" можно и ошибиться...

P.S. В Delphi "удобная штука" нет, Вы верно написали надо циклом выводить.

Сергей Бендер
Профессионал

ID: 304622

# 3

= общий = | 29.09.2009, 21:50 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Рабочий код -- это чуть позже. Сейчас некогда.

Но пока стоит IMHO самому попробовать. Я ж практически всё расписал прямым текстом ;).


Посетитель

ID: 5994

# 4

= общий = | 30.09.2009, 08:55 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Сергей Бендер:

© Цитата: Сергей Бендер
Я ж практически всё расписал прямым текстом ;).
Так то оно так, но я СЛАУ изучал лет 20 назад, так что программировать то я могу, а вот что там делать когда строки меняются и т.д. уже тяжко "въезжать".

© Цитата: Сергей Бендер
Рабочий код -- это чуть позже.
Ок. Буду ждать. Поэтому поставлю за ответ пять. (в надежде всё таки на рабочий код).

За ранее спасибо!

Сергей Бендер
Профессионал

ID: 304622

# 5

= общий = | 02.10.2009, 18:55 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

LanK:
Завтра :)

Сергей Бендер
Профессионал

ID: 304622

# 6

= общий = | 03.10.2009, 20:45 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

LanK:
Ну вот.

Во первых, признаю себя ослом. То, что я предлагал, по исправлению алгоритма -- ерунда. Я недостаточно вгляделся в текст твоей программы -- там несколько другой алгоритм решения, чем тот который я привык видеть.

Во вторых, лучше, конечно, менять местами строки, а не столбцы -- там не надо запоминать перестановки в x. Я думал об этом с начала, но перестраховался -- боялся, что можно упустить некоторые случаи. Похоже что зря. Будем менять местами строки.

В третьих, пишу исправления только для самого алгоритма. Остальное, конечно же, не меняется.

В четвёртых, деление на ноль всё равно может произойти, но это для линейно зависимой матрицы системы. Тогда решения либо нет, либо много. Это уже другая задача.

//Прямой ход - исключение переменных 
for i:=1 to n-1 do
begin
     j:=i;
     while (a[j,i]=0) and (j<=n) do inc(j);
     if j<>i then
     begin
          for k:=1 to n do
          begin
               h:=a[i,k];
               a[i,k]:=a[j,k];
               a[j,k]:=h;
          end;
          h:=b[i];
          b[i]:=b[j];
          b[j]:=h;
     end;
     for j:=i+1 to n do
     begin
          a[j,i]:=-a[j,i]/a[i,i];
          for k:=i+1 to n do
              a[j,k]:=a[j,k]+a[j,i]*a[i,k];
          b[j]:=b[j]+a[j,i]*b[i]
     end;
end;

//Обратный ход - нахождение корней
for i:=n downto 1 do
begin
h:=b[i];
for j:=i+1 to n do
h:=h-x[j]*a[i,j];
x[i]:=h/a[i,i]
end;


Посетитель

ID: 5994

# 7

= общий = | 05.10.2009, 08:52 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Сергей Бендер:
Спасибо!
Правда, я уже переписал алгоритм полностью. Без деления. Хотя он получился не особо красивым, но матрицу 5000*5000 решает далее вылетает (похоже при заполнении результатов в StringGrid).

Сергей Бендер
Профессионал

ID: 304622

# 8

= общий = | 05.10.2009, 13:23 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

LanK:

© Цитата:

Правда, я уже переписал алгоритм полностью. Без деления.


А в чём там суть? Он ведь несовместную систему всё равно не может решить?


Посетитель

ID: 5994

# 9

= общий = | 06.10.2009, 09:13 | цитировать цитировать  | профиль профиль  |  отправить письмо в личную почту пейджер

Сергей Бендер:
Несовместную да, конечно не может. Просто в системе получается много уравнений - как я писал около 1000. И если использовать деление получаются очень большие погрешности. Поэтому всё просто - домнажаем и вычитаем строки. Получаем "единичную" матрицу, затем прогоняем обратно по Жордану. Получаем решение. Если по Гауссу не проходит на диагональ выпадает ноль - то решений нет.

 

Возможность оставлять сообщения в мини-форумах консультаций доступна только после входа в систему.
Воспользуйтесь кнопкой входа вверху страницы, если Вы зарегистрированы или пройдите простую процедуру регистрации на Портале.

Яндекс Rambler's Top100

главная страница | поддержка | задать вопрос

Время генерирования страницы: 0.15592 сек.

© 2001-2018, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.55 от 06.11.2018