Решение СЛАУ методом Крамера , проблема нулевых элементов в главной диагонали

[bizzz]

Привет!
Есть задача сделать программу для решения СЛАУ методом Крамера.
Я нашел очень хороший вариант (см. внизу) от volvo877 (спасибо!)
Единственный минус - нет "защиты от пользователя"
А она требуется даже немного более продвинутая, чем обычно (т.е. не просто, чтобы буквы вместо чисел отлавливать):
метод, в частности, основан на делении на диагональные элементы матрицы

d := a[j, i] / a[i, i];

Подразумевается, что пользователь будет давать такие матрицы, в которых диагональные элементы не равны нулю, а если таковое и случилось - то только в том, случае, когда все комбинации детерминанта = 0.
Но при тесте программы неожиданно встал вопрос: а если пользователь (по незнанию) введёт, к примеру (ранг матрицы=3), такие данные (коэффициенты при х):
0 1 0 = 1
1 0 0 = 1
1 0 1 = 2
Решение у такой системы есть, но при таком порядке уравнений (строк в матрице) программа его не найдёт! ;(
Достаточно лишь поменять местами первые две строки матрицы (тем самым убрав нули из главной диагонали) и всё заработает.
Но так сделает программист, а не пользователь... Нужно как-то это автоматизировать, причём для рангов матрицы до n=16.
Я хотел сделать функцию, которая, найдя нулевой элемент в главной диагонали, искала бы в этом же столбце ненулевой и переставляла строчки местами,
но не смог реализовать это: алгоритм её для произвольного (1<n<16) n для меня не очевиден, да и та, что я смог сделать, в некоторых ситуациях зацикливалась в бесконечность...

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

Вот программа volvo:

{$N+}
{ Задаем порядок системы уравнений }
Const n = 3;
 
Type
  { Тип, описывающий матрицу системы (включая свободные члены !!!) }
  Equation = Array[1 .. n, 1 .. Succ(n)] Of Double;
  matrix =
    Array[1 .. n, 1 .. n] Of Double;
 
Const
  a: Equation =
   ((2, 1, 3, 9),
    (1, -2, 1, -2),
    (3, 2, 2, 7));
 
{ Процедура замены очередного столбца матрицы на свободные члены }
Procedure GetMatrix(wout: Integer; Var m: matrix);
  Var i, j: Integer;
  Begin
    For i := 1 To n Do
      For j := 1 To n Do
        If j <> wout Then m[i, j] := a[i, j]
        Else m[i, j] := a[i, Succ(n)]
  End;
 
{ Нахождение определителя }
Function Det(a: matrix; n: integer): Double;
  Var i, j, k: Integer; d: Double;
  Const
    Eps = 10E-6;
  Begin
    For i := 1 To Pred(n) Do
      Begin
        If Abs(a[i, i]) < Eps Then
          Begin
            Det := 0.0; Exit
          End;
 
        For j := Succ(i) To n Do
          Begin
            d := a[j, i] / a[i, i];
            For k := i To n Do
              a[j, k] := a[j, k] - d * a[i, k];
          End;
      End;
    d := 1.0;
    For i := 1 To n Do
      d := d * a[i, i];
    Det := d
  End;
 
Var
  i: Integer;
  mx: matrix;
  Determ: Double;
begin
  GetMatrix(Succ(n), mx);
  Determ := Det(mx, n);
 
  If Abs(Determ) < 1E-6 Then
    Writeln( 'Определитель исходной матрицы = 0' )
  Else
    For i := 1 To n Do
      Begin
        GetMatrix(i, mx);
        WriteLn( 'x(', i, ') = ', (Det(mx, n) / Determ):7:4 )
      End

Сообщение отредактировано: bizzz - 05.10.06, 15:25

[SeaGirl]

Цитата bizzz @ 05.10.06, 15:23

Я хотел сделать функцию, которая, найдя нулевой элемент в главной диагонали, искала бы в этом же столбце ненулевой и переставляла строчки местами,
но не смог реализовать это: алгоритм её для произвольного (1<n<16) n для меня не очевиден, да и та, что я смог сделать, в некоторых ситуациях зацикливалась в бесконечность...

Покажи что у тебя получилось.

[volvo877]

bizzz, скажу сразу - готового решения у меня нет, мелькнула одна интересная идея. Смотри:

const
  n = 3;
  Equation: Array[1 .. n, 1 .. Succ(n)] Of Integer = (
 
    (0, 1, 0, 1),
    (1, 0, 0, 1),
    (1, 0, 1, 2)
 
  );
 
type
  T = set of byte;
var
  Arr: Array[1 .. n] of T;
  i, j: integer;
 
begin
  for i := 1 to n do Arr[i] := [];
 
  for i := 1 to n do
    for j := 1 to n do begin
 
      if Equation[i, j] = 0 then Exclude(Arr[i], j)
      else Include(Arr[i], j);
 
    end;
 
  for i := 1 to n do begin
 
    write('[');
    for j := 0 to n do
      if j in arr[i] then write(j:3);
    writeln(']');
 
  end;
end.

Вот результат, возвращаемый этой программкой:

[  2]
[  1]
[  1  3]

Уловил смысл? То есть, других вариантов как бы и нет, кроме того, что ты предложил (поменять первую и вторую строку). Я попробую развить эту идею (вполне возможно, кстати, что она ошибочная, я ничего пока не могу утверждать), но и ты тоже попробуй подумать над этим, договорились?

[bizzz]

volvo877, спасибо за попомщь.

Цитата volvo877 @ 05.10.06, 15:56

договорились?

Конечно, это подразумевается по умолчанию, что сначала думаю я а потом уже задаю вопрос, если сам не додумался

Я не обладаю всей полнотой знания паскаля, поэтоу даже тип set или операции Exclude/Include для меня новы.
Я понял программа в итоге убирает все элементы из arr, равные нулю. И под конец же имеем некую сетку с координатами не равных нулю элементов. Верно я понял?

Возможно я понял назначение программы, но идею я, похоже, не уловил ;(

Попробую развить свои идею:
находим 0 в главной диагонали в столбце j - запускаем перебор по этому столбцу пока не найдём не равный 0 элем... уфф словами долго, попробую вставить свой код:

var i,j,q,z:byte; arr:array[1..n] of integer; matr:matrix;
begin
for i:=1 to n do
for j:=1 to n do
{ a := Equation тут}
matr[i,j]:=a[i,j];
 
 
for i:=1 to n do
 if a[i,i]=0 then
  if arr[i]=0 then
   for q:=1 to n do
    if a[q,i]<>0 then begin
      for z:=1 to n do begin
       matr[i,z]:=a[q,z];
       matr[q,z]:=a[i,z];
       end;
      arr[q]:=1;
      break;
      end;

вот так, перемещает строчки только если они ещё не были перемещены (arr[i]=0)
это то, как я хочу, чтобы оно работало, на самом деле что-то не получается ;(

[volvo877]

Цитата bizzz @ 05.10.06, 16:57

программа в итоге убирает все элементы из arr, равные нулю. И под конец же имеем некую сетку с координатами не равных нулю элементов. Верно я понял?

Не совсем... Программа запоминает, в какой позиции может находиться соответствующая строка. Т.е., если элемент №2 в определенной строке равен нулю, то эту строку уже однозначно нельзя поставить на второе место (второй сверху). Поэтому из множества возможных НОВЫХ позиций для этой строки 2 нужно удалить, если оно там уже есть. Этим и занимается Exclude - удалить элемент из множества. Если же i-ый элемент НЕ равен 0, то строка может находиться в этой позиции, и номер i нужно включить (Include) во множество... Ну, и в результате - получили то, что получили - строка, которая сейчас первая может быть только второй; та, которая сейчас вторая - только первой; а та, которая сейчас третья - может быть первой или третьей. Теперь более понятно?

[bizzz]

Цитата volvo877 @ 05.10.06, 17:06

Теперь более понятно?

О да, спасибо за объяснение!
Остаётся открытым вопрос о реализации выбора (какие строки переставлять) в случаях, когда он не однозначен.
Можно, в принципе, переставлять по одной строчке до тех пор, пока либо все элементы главной диагонали будут НЕ равны нулю, либо не останется строчка (или не одна, несколько строк), которая стоит не на своём месте, но и перемещена быть не может - если такое случилось - всё, теперь точно отказываемся от продолжения.
Я попробую это сделать

Сообщение отредактировано: bizzz - 05.10.06, 17:30

[volvo877]

Сразу хочу сказать: это - не совсем корректная реализация, рассчитанная только на то, чтоб объяснить сам принцип. По-хорошему надо бы хранить не только множество разрешенных позиций, но и множество запрещенных, но это уже дело техники...

Цитата bizzz @ 05.10.06, 17:25

в случаях, когда он не однозначен

Нужно проверить, есть ли вообще решение: проходить по ВСЕМ множествам, и если в каком-то из них есть ОДИН элемент - удаляешь его из всех остальных множеств. Если в результате ты получишь хоть одно пустое множество - значит матрицу нельзя привести к нужному виду простой перестановкой строк. Попробуй это реализовать...

[bizzz]

Цитата volvo877 @ 05.10.06, 17:31

Попробуй это реализовать...

Спасибо, попробую
Завтра рано утром - сейчас уже не так чётко всё.
Поставлю себе задачу как я её понимаю:
1. из твоего примера сделать вывод в массив: номер строки исходной матрицы | возможные варианты расстановки
2.

Цитата volvo877 @ 05.10.06, 17:31

если в каком-то из них есть ОДИН элемент - удаляешь его из всех остальных множеств

3. проверка на пустоту множеств
4. если всё ОК - последовательное перемещение строк

Сообщение отредактировано: bizzz - 05.10.06, 19:52

[volvo877]

bizzz, прежде, чем ты начнешь изобретать этот велосипед, загляни сюда, я уже выкладывал нечто подобное - хорошо, что вспомнил:

Возвращаемся к матрицам и определителям (сообщение #1043423)

[bizzz]

volvo877, о да! :)
Спасибо! :D
Мне казалось, что алгоритм, предложенный тобой, сложнее, чем вся программа в целом до него.
Я думал, что создатели задачи не подразумавали такой трудоёмкости ;)
А тут на тебе! :) Пожалуй - это и есть тот уровень, который они (могли) подразумевали :)
Насчёт решенности вопроса - подождём вечера

[Bug Hunter]

Цитата bizzz @ 06.10.06, 05:20

Я думал, что создатели задачи не подразумавали такой трудоёмкости
А тут на тебе! Пожалуй - это и есть тот уровень, который они (могли) подразумевали

Я думаю, что составители задачи не подразумевали такого идеотизма.
Проблема в том коде, который привел Вольво, заключаеться в том, что подпрограмма
вычисления определителя работает неверно. Сам посмотри - для той матрицы,
которую ты привел, значение определителя равно -1, а подпрограмма Вольво с
какого-то перепугу считает, что он равен нулю. Отсюда вывод - надо правильно
реализовать подпрограмму вычисления определителя, а не пытаться преобразовать
исходные данные так, чтобы неправильная подпрограмма выдавала на них
правильный результат. Даже если последняя задача и разрешима (в чем я лично
очень сомневаюсь), она абсолютно бессмысленна.
Так что учимся вычислять определители.
Причем правильно!

[volvo877]

Bug Hunter, я бы попросил две вещи: во-первых, перейти из режима Write-only в хотя бы иногда режим чтения, а во-вторых проследить за своим лексиконом. Я ясно выражаюсь?

Цитата volvo877 @ 14.03.06, 11:01

(если элемент главной матрицы - нулевой, то строка, его содержащая переносится на другую позицию. Знак детерминанта изменится, потому что одна перестановка строк меняет знак определителя)

Это Вы, уважаемый, не заметили в силу чьего идиотизма? Я что, где-то обязывался приводить программы "под ключ"? Я понимаю, легко рассуждать, когда своих программ на форума - пальцев на двух руках хватит, чтоб пересчитать. Как видно, чтоб не было критики, ничего не постите, кроме досужих рассуждений?

[Bug Hunter]

Цитата volvo877 @ 07.10.06, 18:59

Цитата (volvo877 @ 14.03.06, 14:01)
(если элемент главной матрицы - нулевой, то строка, его содержащая переносится на другую позицию. Знак детерминанта изменится, потому что одна перестановка строк меняет знак определителя)
Это Вы, уважаемый, не заметили в силу чьего идиотизма?

Ну, и? Действие над матрицей и свойства этого действия описаны правильно. Только
вот для получения результата - преобразования матрицы к треугольному виду -
требуется выполнять правильные действия в правильной последовательности. А Вы,
уважаемый , второй раз наступаете на те же грабли - предлагаете сначала
убрать нули с главной диагонали, а затем предлагаете делать другие действия,
которые опять, как Вы сами же правильно заметили, могут привести к появлению
нулей на главной диагонали. Хотя последовательность действий для преобразования
матрицы к треугольному виду (ровно как и способы подсчета определителей матрицы)
описаны в любом ВУЗовском учебнике по основам высшей математике, расказаны на
лекциях, проработаны на семинарах и являються задачами, обязательными к решению
студентами первого семестра любого технического ВУЗа. Т.е. если студент не
может решить такую задачу на зачете, его просят придти в другой раз. Попозже.
А теперь потрудитесь, пожалуйста, объяснить, в силу чьего идеотизма или в силу
каких жизненных обстоятельств Вы не умеете решать задачи первого семестра?

Цитата volvo877 @ 07.10.06, 18:59

Я что, где-то обязывался приводить программы "под ключ"?

А где я тебе за ЭТО предъяву делаю? Более того, насколько я помню, когда ты
постил эту прогу первый раз, ты оговорил, что она являеться ограничено
работоспособной и только демонстрирует метод Крамера. Ты мог бы вообще даже
ограниченную реализацию подпрограммы подсчета определителя не делать, оставив
заглушку.
Идеотизм ситуации здесь в другом. Челу нужна работоспособная программа. Так вот,
вместо того, что бы подсказать (никто не заставляет тебя делать реализацию), что
надо разбираться с ограничено работоспособной (т.е. неправильной)
подпрограмммой, или просто промолчать (Иногда лучше жевать! )ты поддерживаешь
ОЧЕВИДНО ахенеистическое направление по преобразованию исходных данных так,
чтобы неправильный код мог их правильно обработать! Ну, если это не идеотизм,
то я просто не знаю что.

Цитата volvo877 @ 07.10.06, 18:59

Я понимаю, легко рассуждать, когда своих программ на форума - пальцев на двух руках хватит, чтоб пересчитать. Как видно, чтоб не было критики, ничего не постите, кроме досужих рассуждений?

ИНТЕРЕСНЫЕ вопросы, которые для ПОМОЩИ в их решении требуют именно приведения
фрагмента кода, возникают крайне редко. А зарабатывать себе дутый рейтинг, решая
легкие лабы для бездельников, мне не интересно. Ку?
Я понимаю, что указания, которые могут помочь самостоятельно решить задачу
человеку с головой и желанием чему то научиться могут быть восприняты отдельными
недалекими товарищами как досужие рассуждения, но это их личные тараканы. Мне
плевать. Хотя иногда конечно бывает и обидно.