На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! правила раздела Алгоритмы
1. Помните, что название темы должно хоть как-то отражать ее содержимое (не создавайте темы с заголовком ПОМОГИТЕ, HELP и т.д.). Злоупотребление заглавными буквами в заголовках тем ЗАПРЕЩЕНО.
2. При создании темы постарайтесь, как можно более точно описать проблему, а не ограничиваться общими понятиями и определениями.
3. Приводимые фрагменты исходного кода старайтесь выделять тегами code.../code
4. Помните, чем подробнее Вы опишете свою проблему, тем быстрее получите вразумительный совет
5. Запрещено поднимать неактуальные темы (ПРИМЕР: запрещено отвечать на вопрос из серии "срочно надо", заданный в 2003 году)
6. И не забывайте о кнопочках TRANSLIT и РУССКАЯ КЛАВИАТУРА, если не можете писать в русской раскладке :)
Модераторы: Akina, shadeofgray
  
> Метод Зейделя и Гаусса для системы уравнений.
    Есть система уравнений, например:
    3Х1+4Х2-2Х3=4
    -Х1-Х2+3Х3=6
    Х1-7Х2+Х3=-2
    Необходимо решить 2я методами (Зейделя и Гаусса).
    Желательно алгоритм, или текст программы (лучше 2е biggrin.gif )
    Заранее благодарен!
    Сообщение отредактировано: Black_Star -
      faq you!!
      могу дать собственноручно написанного гаусса на тмт паскале с асмеблерными вставками
        Пуляй, авось пойму что blink.gif
        А что насчет Зейделя?
          яж тебе сказал, смотри фак! там зейдель был, правда без комментариев
          да и про гаусса там есь
          что такое зейдель я сам до сих пор не знаю.

          ищо смотри на http://algolist.manual.ru/ smile.gif

          гаусс

          CODE
          procedure sub_mul_vec_d(var vec1, vec2: double; coef: extended; const dim: longint); assembler;
          asm
           fld tbyte ptr coef
           mov eax, dim
           dec eax
           js @exit
           mov edi, dword ptr vec1
           mov esi, dword ptr vec2
           @1:
           fld st(0)
           fld qword ptr [esi+eax*8]
           fmul
           fld qword ptr [edi+eax*8]
           fsub
           fstp qword ptr [edi+eax*8]
           dec eax
           jns @1
           @exit:
           fstp tbyte ptr coef
          end;

          function correct_zero(var a, b: array of double; i, dim: integer): integer;
          {чтобы не было нуля по диагонали}
          var j, max_pos: integer; max: double;
          begin
           max_pos:=i;
           max:=abs(a[i*(1+dim)]);
           for j:=i+1 to dim-1 do if abs(a[i+j*dim])>max then begin
            max:=abs(a[i+j*dim]);
            max_pos:=j;
           end;
           if abs(a[i*(1+dim)])<0.1*max then begin
            sub_vec_d(a[i*(1+dim)], a[i+max_pos*dim], dim-i);
            b[i]:=b[i]-b[max_pos];
           end;
           if max=0 then correct_zero:=1 else correct_zero:=0;
          end;

          procedure _solve(var a, b, x: array of double; dim: integer);
          var i, j: integer; k: extended;
          begin
           for i:=0 to dim-2 do begin
            correct_zero(a, b, i, dim);
            for j:=i+1 to dim-1 do begin
             k:=a[i+j*dim]/a[i*(1+dim)];
             b[j]:=b[j]-b[i]*k;
             sub_mul_vec_d(a[i+j*dim+1], a[i*(1+dim)+1], k, dim-i-1);
            end;
           end;
           for i:=dim-1 downto 1 do for j:=0 to i-1 do begin
            k:=a[i+j*dim]/a[i*(1+dim)];
            b[j]:=b[j]-b[i]*k;
           end;
           for j:=0 to dim-1 do x[j]:=b[j]/a[j*(1+dim)];
          end;

          спрашивай чо не поймёшь
            Пока большое спасибо, буду разбираться wink.gif
              В курсовой по электротехнике и технологиям программирования попался вариант, где решение системы уравнений(для определения токов в 6 ветвях цепи) решается методом Гаусса. Я это дело закодил, проверил, но не учел того что система (составленная по первому и второму законам Кирхгофа) в первых 3 уравнениях имеет много нулей.. Из-за этого метод вылетает с ошибкой.
              Первые 3 строки из матрицы коэффициентов:
              1)1 -1 0 0 -1 0
              2)-1 0 -1 1 0 0
              3)0 0 0 -1 1 1
              Стопорится всегда вот здесь(деление на нуль, при i=3, то есть LowMatrix[3,3]=0 :() :
              UpMatrix[i,j]:=(Matrix[i,j]-TempSum2)/LowMatrix[i,i];
              Буду очень признателен человеку, который поможет усовершенствовать алгоритм и дописать в него выбор максимального элемента по столбцу.
              ExpandedWrap disabled
                unit Gauss;
                interface
                type
                  Matrix_6x6=
                            array[1..6] of array[1..6] of real; //Матрица 6x6
                  VectorStolbec6=
                            array[1..6] of real; //Вектор-столбец свободных членов
                function GaussMethod(Matrix:Matrix_6x6; Vector:VectorStolbec6):VectorStolbec6;
                implementation
                function GaussMethod(Matrix:Matrix_6x6; Vector:VectorStolbec6):VectorStolbec6;
                var LowMatrix:Matrix_6x6;
                    UpMatrix:Matrix_6x6;
                    i,j,k,l:integer;
                    TempSum,TempSum2:real;
                    Y, X:VectorStolbec6; //Векторы Y, X для решения 2 систем уравнений
                begin
                {!-------------Часть 1. Разложение A=LU-------------!}
                //Обнуление матриц и векторов
                for i:=1 to 6 do
                for j:=1 to 6 do
                begin
                UpMatrix[i,j]:=0;
                LowMatrix[i, j]:=0;
                Y[i]:=0;
                X[i]:=0;
                end;
                //Самые примитивные вычисления
                for i:=1 to 6 do
                LowMatrix[i, 1]:=Matrix[i, 1];
                //
                for i:=2 to 6 do
                UpMatrix[1, i]:=Matrix[1, i]/LowMatrix[1,1];
                 
                for i:=1 to 6 do
                UpMatrix[i,i]:=1;
                //Начало разложения:
                TempSum:=0;
                TempSum2:=0;
                for i:=2 to 6 do
                for j:=2 to 6 do
                 
                    begin
                      //Верхняя треугольная матрица U
                    if (j>i) and (j>1) then
                    begin
                    TempSum2:=0;
                    for l:=1 to i-1 do
                    TempSum2:=TempSum2+LowMatrix[i,l]*UpMatrix[l,j];
                    Form1.Caption:=inttostr(i);
                    UpMatrix[i,j]:=(Matrix[i,j]-TempSum2)/LowMatrix[i,i];
                    end;
                    //Нижняя треугольная матрица L
                    if (j>1) and (j<=i) then
                    begin
                    TempSum:=0;
                    for k:=1 to j-1 do
                    TempSum:=TempSum+LowMatrix[i,k]*UpMatrix[k, j];
                    LowMatrix[i,j]:=Matrix[i,j]-TempSum;
                     end;
                    //
                 
                    end;
                {!-------------Конец разложения-------------!}
                 
                {!-------------Часть 2. Нахождение корней--------!}
                //Сначала решаем систему Ly=b и находим вектор Y
                TempSum:=0;
                for i:=1 to 6 do
                begin
                if i>=1 then
                          begin
                TempSum:=0;
                for k:=1 to i do
                TempSum:=TempSum+LowMatrix[i, k]*Y[k];
                Y[i]:=(Vector[i]-TempSum)/LowMatrix[i,i];
                          end;
                end;
                {Нужно было для отладки
                Form1.Memo1.Lines.Add('Y1: '+floattostr(Y[1]));
                Form1.Memo1.Lines.Add('Y2: '+floattostr(Y[2]));
                Form1.Memo1.Lines.Add('Y3: '+floattostr(Y[3]));
                //----конец
                }
                //После нахождения вектора Y переходим к нахождению вектора X
                //Его находим из системы Ux=y
                TempSum:=0;
                for i:=6 downto 1 do//Так как ход обратный
                begin
                TempSum:=0;
                for k:=i+1 to 6 do begin
                TempSum:=TempSum+UpMatrix[i,k]*X[k];
                end;
                X[i]:=Y[i]-TempSum;
                end;
                {!-------------Конец. Корни найдены, возвращаем результат в виде вектора--------!}
                Result:=X;
                end;
                  end.
                VeRmuTT, если ты о задаче избавления от нулей на главной диагонали матрицы - то вот тут было кое-что:
                Возвращаемся к матрицам и определителям (сообщение #1043423)
                  Да, но там стоит задача найти определитель, а в моем случае по-моему никак нельзя делать то что там описано в процедуре diagonal... Скорее всего, у меня не получится решить мою систему методом LU разложения... Вот нашел отличный алгоритм(с выбором максимального элемента, там с нулями нет проблемы), но он на Си, а в Паскаль не могу перевести(корни не те выдает). Если кто возмётся помочь-дам код
                    Ну, запость его в разделе Паскаль - поможем перевести...
                    0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                    0 пользователей:


                    Рейтинг@Mail.ru
                    [ Script execution time: 0,0270 ]   [ 15 queries used ]   [ Generated: 28.03.24, 14:11 GMT ]