18.06.2019, 13:12 [+3 UTC]
в нашей команде: 3 711 чел. | участники онлайн: 12 (рекорд: 21)

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

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

все разделы

правила

новости

участники

доска почёта

форум

блоги

поиск

статистика

наш журнал

наши встречи

наша галерея

отзывы о нас

поддержка

руководство

Версия системы:
7.77 (31.05.2019)
JS-v.1.34 | CSS-v.3.35

Общие новости:
28.04.2019, 09:13

Форум:
18.06.2019, 08:32

Последний вопрос:
17.06.2019, 15:06
Всего: 149828

Последний ответ:
18.06.2019, 12:04
Всего: 258619

Последняя рассылка:
17.06.2019, 20:45

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

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

Наша кнопка:

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

Отзывы о нас:
18.01.2012, 16:34 »
Даровко Антон Владимирович
Я посмотрел Ваш ответ и оценил его на отлично. [вопрос № 185202, ответ № 269623]
08.09.2010, 11:43 »
Massimo
Большое спасибо за помощь!!! [вопрос № 179872, ответ № 262996]

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

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

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

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

Зенченко Константин Николаевич
Статус: Старший модератор
Рейтинг: 240
puporev
Статус: Профессионал
Рейтинг: 120
zdwork
Статус: 2-й класс
Рейтинг: 120

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

Консультация онлайн # 195738
Раздел: • Pascal / Delphi / Lazarus
Автор вопроса: mustang289 (Посетитель)
Отправлена: 27.05.2019, 23:50
Поступило ответов: 1

Здравствуйте! У меня возникли сложности с таким вопросом:
Решение системы линейных алгебраических уравнений метод
квадратных корней (Холецкого)
Матрица А коэффициентов системы-
1,53 1,61 1,43
2,35 2,31 2,07
3,83 3,73 3,45
Столбец свободных членов b-
-5,13
-3,69
-5,98
в Delphi

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

Здравствуйте, mustang289!

Код (Pascal) :: выделить код
const
  sizemat = 10;
type
  mattype = array[1..sizemat, 1..sizemat] of real;
  mattype1 = array[1..sizemat] of real;
procedure writemat(var a: mattype; n, m: byte);
var
  i, j: byte;
begin
  writeln;
  for i := 1 to n do
  begin
    for j := 1 to m do
      write(a[i, j]:7:3, ' ');
    writeln
  end;
end;
procedure inputmat(var a: mattype; var d: mattype1; var n: byte);
var
  i, j: byte;
begin
  writeln;
  write('size = ');
  readln(n);
  writeln;
  writeln;
  for i := 1 to n do
    for j := 1 to n do
      begin
        write('a[',i,',',j,']:=');
        read(a[i, j]);
      end;
  writeln;
  for i := 1 to n do
    begin
      write('b[',i,']=');
      readln(d[i]);
    end;
  writeln;
end;
procedure getBnC(var a, b, c: mattype; n: byte);
var
  k, i, a1, j: byte;
begin
  for k := 1 to n do
    for i := 1 to n do
      begin
        if k = i then c[k, i] := 1
          else c[k, i] := 0;
          b[k, i] := 0;
      end;
  for a1 := 1 to n do
  begin
    if a1 = 1 then
    begin
      for i := 1 to n do
        b[i, 1] := a[i, 1];
      for i := 2 to n do
        c[1, i] := a[1, i] / b[1, 1];
    end
    else
    begin
      k := a1;
      for i := a1 to n do
      begin
        b[i, k] := a[i, k];
        for j := 1 to k - 1 do
          b[i, k] := b[i, k] - b[i, j] * c[j, k];
      end;
      i := a1;
      for k := i + 1 to n do
      begin
        c[i, k] := a[i, k];
        for j := 1 to i - 1 do
          c[i, k] := c[i, k] - b[i, j] * c[j, k];
        c[i, k] := c[i, k] / b[i, i];
      end;
    end;
  end;
end;
procedure otvet(var b, c: mattype; d: mattype1; n: byte);
var
  x, y, s: mattype1;
  i, j, k: byte;
  w, q: real;
  y1, x1: mattype;
begin
  for i := 1 to n do
    if i = 1 then y[i] := d[i] / b[i, i]
    else
    begin
      w := 0;
      for k := 1 to i - 1 do
      begin
        y1[i, k] := w + b[i, k] * y[k];
        w := y1[i, k];
      end;
      y[i] := (d[i] - w) / b[i, i];
    end;
  for i := n downto 1 do
    if i = n then x[i] := y[i]
    else
    begin
      q := 0;
      for k := i + 1 to n do
      begin
        x1[i, k] := q + c[i, k] * x[k];
        q := x1[i, k];
      end;
      x[i] := y[i] - q;
    end;
  writeln;
  writeln('roots X:');
  writeln;
  for i := 1 to n do
    writeln('x[', i, ']= ', x[i]:1:4);
  writeln;
end;
var
  a, a1, c, b: mattype;
  d: mattype1;
  n: byte;
begin
  InputMat(a, d, n);
  getBnC(a, b, c, n);
  Writeln('matrix B: ');
  writemat(b, n, n);
  Writeln('matrix C: ');
  writemat(c, n, n);
  otvet(b, c, d, n);
  readln;
end.

Код брался тут.

Удачи!


Консультировал: Зенченко Константин Николаевич (Старший модератор)
Дата отправки: 06.06.2019, 18:56

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

0

[подробно]

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

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

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

Яндекс Rambler's Top100

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

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

© 2001-2019, Портал RFPRO.RU, Россия
Калашников О.А.  |  Гладенюк А.Г.
Версия системы: 7.77 от 31.05.2019
Версия JS: 1.34 | Версия CSS: 3.35