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

> Внимание!

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

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Метод Лобачевского, хелп курсач!
сообщение
Сообщение #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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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

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


//////////////////////////////////////////////////////////////////////////////
// Solving nonlinear equations (Lobachevsky method)
// © 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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


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


Гость






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

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

 





- Текстовая версия 22.10.2021 17:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name