IPB
ЛогинПароль:

> Внимание!

1. Пользуйтесь тегами кода. - [code] ... [/code]
2. Точно указывайте язык, название и версию компилятора (интерпретатора).
3. Название темы должно быть информативным. В описании темы указываем язык!!!

 
 Ответить  Открыть новую тему 
> Метод Лобачевского, хелп курсач!
So Slow
сообщение 20.05.2007 6:42
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 21
Пол: Мужской
Реальное имя: Stas

Репутация: -  0  +


у кого-нибуть есть метод Лобачевского нахождения корней многочлена?

я нашёл метод методе Лобачевского-Греффе (ну эт практически одно и тоже), но эта прога на каком-то другом языке(фортран вродеб), и там ничего не понятно.


program MLG

implicit none



double precision, dimension(0:4) ::a1,b2,eps,summa

double precision, dimension(0:8) ::b1

double precision, dimension(1:4) ::y,lg,dx

double precision, dimension(1:3) ::b3

double precision koef,v,sumcmplx,prcmplx,e1,e2, epsilon

double complex deskr

double complex, dimension(1:4) ::x

logical, dimension(0:4) ::mask

logical, dimension(1:4) ::flags

logical flag

integer i,k,m

! задание начальных значений

epsilon = 1e-3

print *,\'vvedite koeffitsienty mnogochlena\', \' \'

read *, a1 !чтение данных

!открытие файла для записи данных

open (3, file=\'res2.txt\', status=\'replace\')

write (3,10) a1

10 format (t3,\'коэффициенты исходного многочлена\',5(2x,es15.7))

write (3,11) epsilon

11 format (t3,\'ограничение точности \',es15.7)

y = 0.0

mask = .true.

b1 = 0.0

b1(0:4) = a1

flag = .true.

k=0



!операция квадрирования корней

do while (flag)

k = k + 1 !считаем номер итерации

write (3,1) k

1 format (t60,\'итерация No \',t75,i2)

b2 = b1(0:4)*b1(0:4)

summa = (/(2*s(i),i=0,4)/)

write (3,2) summa

2 format (t3,\'удвоенная сумма\',5(2x,es15.7))

print *,\' \'

b2 = (/(b2(i)+2*s(i),i=0,4)/) !вычисление коэффициентов

write (3,3) b2

3 format (t3,\'коэффициенты \',5(2x,es15.7))

mask = mask .and. (b2 > 0) !определение действительных
корней

eps = 0.0

where (mask) eps = abs(b2/(b1(0:4)*b1(0:4))-1)

flag = maxval(eps)
>epsilon !ограничение точности

if (.not. flag) then

k = k-1

do i=1,4

if (.not. mask(i)) then

e1 = abs(b2(i-1) - b1(i-1)*b1(i-1))

e2 = abs(b2(i+1) - b1(i+1)*b1(i+1))

koef = 1/exp((k+1)*LOG(2.0))

dx(i) = koef*(e1/(b1(i-1)*b1(i-1))+e2/(b1(i+1)*b1(i+1)))

else

e1 = abs(b2(i-1) - b1(i-1)*b1(i-1))

e2 = abs(b2(i) - b1(i)*b1(i))

koef = 1/exp((k+1)*LOG(2.0))

dx(i) = koef*(e1/(b1(i-1)*b1(i-1))+e2/(b1(i)*b1(i)))

end if

end do

else

b1(0:4) = b2 !запоминаем значение коэффициентов на текущей итерации

end if

write (3,4)

4 format (t3,\' \')

end do



!определение номеров комплексных корней

do i=1,4

if (.not. mask(i)) m=i

end do

mask(m+1) = .false.

dx(m+1) = dx(m)



!вычисление корней в уравнении Q(y) = 0

do i=1,4

if (mask(i)) y(i) = b1(i)/b1(i-1)

end do



!вычисление действительных корней

koef = 1/exp(k*LOG(2.0))

where (mask(1:4)) lg = exp(koef*log(y))



!определение знака действительных корней

flags = .false.

do i=1,4

if (mask(i)) then

v = polinom(lg(i))/polinom(-1.0*lg(i))

flags(i) = (v > 1.0)

end if

end do

where (flags) lg = -1.0*lg

x = lg



!составляем уравнение для нахождения комплексных корней

sumcmplx = -a1(1)/a1(0)

do i=1,4

if (mask(i)) then

sumcmplx = sumcmplx - x(i)

end if

end do



v = -1.0

prcmplx = extent_int(v,4)*a1(4)/a1(0)

do i=1,4

if (mask(i)) then

prcmplx = prcmplx/x(i)

end if

end do



b3(1) = 1.0

b3(2) = -1.0*sumcmplx

b3(3) = prcmplx

!нахождение комплексных корней

v = b3(2)*b3(2)-4*b3(1)*b3(3)

deskr = dcmplx(-1.0*b3(2),sqrt(abs(v)))/(2*b3(1))

x(m) = deskr

x(m+1) = CONJG(x(m))

!вывод результата

write (3,5)

5 format (t3,\'-------------------------------------\')

write (3,6)

6 format (t3,\'полученый результат\')

do i=1,4

write (3,7) x(i)

7 format (t20,2(es15.8,3x))

write (3,8)

8 format (t3,\'\')

end do

write (3,9) dx

9 format (t3,\'относительная погрешность корней \',4(es15.8,2x))

print *,\'vse vychisleniya vypolneny uspeshno\', \' \', \'rezultat sohranen
v faile res2.txt\'

close (3, status=\'keep\')

contains

real(8) function s(a)

integer a,j

real(8) sum

sum = 0.0

do j=1,a

if (mod(j,2) == 0) then

sum = sum + b1(a-j)*b1(a+j)

else

sum = sum - b1(a-j)*b1(a+j)

end if

end do

s=sum

end function s

real(8) function polinom(xp)

real(8) xp,p,xs

integer j,l

p = 0.0

do j=0,4

p = p+ extent_int(xp,j)*a1(4-j)

end do

polinom = p

end function polinom

real(8) function extent_int(num,ext)

real(8) num

integer ext,l

real(8) w

w=1.0

do l=1,ext

w = w*num

end do

extent_int = w

end function extent_int

end program MLG


кто разбераеться переделайте под паскаль ПЛЗ.

ЗЫ если есть на С++, то тож пойдет

Сообщение отредактировано: So Slow - 20.05.2007 6:47
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 20.05.2007 9:15
Сообщение #2


Гость






Есть исходник метода Лобачевского, С++ (С) Johna Smith, 1996

Поскольку раздел Паскалевский - см. приват...

Update
Поскольку тема перенесена в соотв. раздел - вот исходник:


//////////////////////////////////////////////////////////////////////////////
//  Solving nonlinear equations (Lobachevsky method)
//  (c) Johna Smith, 1996
//
//  Method description:
//   Given: a0+a1x+a2x^2+...+anx^n=0
//   This method allows to find modulus of the greatest root of this equation
//   even if it's complex. But in last case there can appear several messages
//   about impossibilty of calculation root of negative number.
//   The main idea of this method is to change given equation to other
//   equation which roots equals to powered roots of given equation. For example
//   if roots of the given equation are x0,x1,.. xn then roots of new equation
//   will be x0^2, x1^2, ..., xn^2. Repeating this operation we get an equation
//   where one root is much greater than other ones. So we can easily
//   obtain modulus of the greatrest root of the given equation.
//   To obtain other roots of equation we need to divide given equation
//   by (x-x0) (where x0 is found root) and apply this method to result.
//
//////////////////////////////////////////////////////////////////////////////
#include <stdio.h>
#include <math.h>
#define N   4
#define N1  N+1
#define Iterations  15  // number of iterations
double a[N1]={24,-50,35,-10,1};
void main(void)
{
  double r,b[N1],c[N1],g,bi,d;
  int z,k;
  // printing given equation
  printf("%f",a[0]);
  for(int i=1;i<N1;i++) printf("%+fx^%d",a[i],i);
  printf("=0\n\n");
  // preparing auxiliary arrays b and c
  for (i=0;i<N1;i++)
  {
    b[i]=a[i]/a[N];
    c[i]=0;
  }
  // setting required parameters
  r=1/2.0;
  g=1;
  // make all iterations
  for(int y=0;y<Iterations;y++)
  {
    // calculate coefficients c[i] (coefficients of new equation)
    z=1;
    for(i=0;i<N1;i++)
    {
      bi=z*b[i];
      k=(i+1)/2;
      for(int j=i%2;j<N1;j+=2)
      {
        c[k]+=bi*b[j];
        k++;
      }
      z=-z;
    }
    d=z*c[N-1];
    // check whether we could calculate root of d
    if(d>0)
    {
      // calculating and printing new iteration
      g*=powl(d,r);
      printf("%f\n",g);
      for (i=0;i<N1;i++)
      {
        // preparing data for next iteration
        b[i]=c[i]/powl(d,N-i);
        c[i]=0;
      }
      b[N-1]=z;
      b[N]=-z;
    } else
    {
      // d is negative - can't calculate root
      for(i=0;i<N1;i++)
      {
        // preparing data for next iteration
        b[i]=c[i];
        c[i]=0;
      }
      printf("no iteration (can't calculate root from negative number)\n");
    }
    r/=2.0;
  }
}



Сообщение отредактировано: volvo - 20.05.2007 12:00
 К началу страницы 
+ Ответить 
So Slow
сообщение 20.05.2007 11:22
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 21
Пол: Мужской
Реальное имя: Stas

Репутация: -  0  +


cпрога хорошая, но вот если корни комплексные, то уже не счетает(, а мене над чтоб комплексные тоже счетал
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 20.05.2007 11:51
Сообщение #4


Гость






А об этом надо было сразу говорить... Посмотрю, что можно сделать...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 31.07.2025 4:19
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"