Форум программистов, компьютерный форум, киберфорум
Free Pascal
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
2 / 2 / 1
Регистрация: 19.12.2014
Сообщений: 43
1

Интерполяция полиномом Лагранжа с узлами Чебышева

26.12.2015, 13:12. Показов 639. Ответов 0
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
не могу понять почему не работает программа
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
program Lagrang;
Uses CRT,Graph;
label again,dont,theend;
type
    mas=array[0..100]of real;
var
   N,a,b,i,j,k,l,x:integer;
   ymtab,xmtab:longint;
   XMas,YMas,M:mas;
   xmax:real;
   ch:char;
   helpstr:string;
{Фу*кция возводит argument в степе*ь stepen>=0}
function power(argument:real;stepen:integer):real;
label end_power;
var help:real;
begin
     if stepen=0 then
                     begin
                          power:=1;
                          goto end_power
                     end;
     help:=argument;
     for k:=2 to stepen do
         help:=help*argument;
     power:=help;
end_power:
end;
{Фу*кция вычисляет ф*ктори*л argument'a}
function factorial(argument:integer):real;
label end_factorial;
var help:real;
begin
     if argument=0 then
                       begin
                            factorial:=1;
                            goto end_factorial
                       end;
     help:=argument;
     for k:=1 to argument-1 do
         help:=help*k;
     factorial:=help;
end_factorial:
end;
{-------------------Фу*кция пользов*теля---------------------------}
function myfunc(x:real):real;
begin
{f(x)=e^x}
{     myfunc:=exp(x)}
 
{f(x)=x^5-6*x^3+x-12}
    myfunc:=power(x,5)-6*power(x,3)+x-12
end;
{------------------------------------------------------------------}
{Процедур* вычисле*ия модуля м*ксим*ль*ой производ*ой}
procedure proizvodnie;
begin
{f(x)=e^x}
{     for l:=1 to 20 do
         M[l]:=abs(exp(b));}
{f(x)=x^5-6*x^3+x-12}
        l:=a;
        if abs(a)<abs(b) then l:=b;
        M[1]:=abs(5*power(l,4)-18*power(l,2)+1);
        M[2]:=abs(20*power(l,3)-36*l);
        M[3]:=abs(60*power(l,2)-36);
        M[4]:=abs(120*l);
        M[5]:=120;
        for l:=6 to 20 do
            M[l]:=0;
 
end;
{Процедур* вычисляет узловые точки Xi и помещ*ет их в м*ссив XMas}
procedure CalcXi;
begin
     XMas[1]:=0;
     for i:=0 to N do
          XMas[i]:=0.5*((b-a)*cos(Pi*(2*i+1)/(2*(N+1)))+(b+a))
end;
 
{Фу*кция вычисляет з**че*ие ИМЛ в узле point}
function iml(point:real):real;
var L,p:real;
begin
     L:=0;
     for i:=0 to N do
         begin
              p:=1;
              for j:=0 to N do
                  if j<>i then p:=p*(point-XMas[j])/(XMas[i]-XMas[j]);
              L:=L+myfunc(XMas[i])*p;
         end;
     iml:=L;
end;
{Фу*кция вычисле*ия пр*ктической погреш*ости}
function prakt_pogr:real;
var t,dmax,current_dx:real;
begin
     xmax:=XMas[0];
     dmax:=abs(myfunc(xmax)-iml(xmax));
     t:=XMas[n];
     while t<=XMas[0] do
         begin
              current_dx:=abs(myfunc(t)-iml(t));
              if current_dx>dmax then
                                   begin
                                        dmax:=current_dx;
                                        xmax:=t;
                                   end;
              t:=t+0.2;
         end;
     prakt_pogr:=dmax;
end;
{Фу*кция вычисле*ия теоретической погреш*ости}
function theory_pogr:real;
begin
     theory_pogr:=(M[n+1]*power(b-a,n+1))/(power(2,2*n+1)*factorial(n+1))
end;
{Процедур* и*ици*лиз*ции гр*фики}
procedure graphini;
var gd,gm:integer;
begin
     gd:=detect;
     initgraph(gd,gm,'egavga.bgi');
end;
{Процедур* созд*ющ*я и*терфейс в гр*фическом режиме, в том числе изобр*ж*ет коорди**т*ую плоскость}
procedure osi;
begin
     setcolor(13);
     line(10,10,60,10);
     outtextxy(62,7,'function');
     setcolor(14);
     line(10,30,60,30);
     outtextxy(62,27,'iml');
     settextstyle(2,0,4);
     setcolor(10);
     outtextxy(10,470,'right/left arrow -Horizontal zoom +/-');
     outtextxy(10,450,'up/down arrow -Vertical zoom +/-');
     settextstyle(0,0,1);
     setcolor(7);
     line(0,240,640,240);
     line(320,0,320,480);
     outtextxy(310,242,'0');
     outtextxy(322,2,'Y');
     outtextxy(632,242,'X');
     k:=320;
     outtextxy(320+5*xmtab,242,'5');
     while k<640 do
           begin
                k:=k+5*xmtab;
                line(k,238,k,242);
                line(640-k,238,640-k,242);
           end;
     k:=240;
     str(ymtab*50,helpstr);
     outtextxy(323,188,helpstr);
     while k<480 do
           begin
                k:=k+50;
                line(318,k,322,k);
                line(318,480-k,322,480-k);
           end;
end;
 
{Тело ос*ов*ой прогр*ммы}
begin
     clrscr;
     textcolor(10);
     writeln('                         -=ИМЛ с узл*ми Чебышев*=-');
     textcolor(7);
     writeln('Введите левую гр**ицу отрезк*');
     readln(a);
     writeln('Введите пр*вую гр**ицу отрезк*');
     readln(b);
     if a>b then begin a:=a+b; b:=a-b; a:=a-b end;
     writeln('Введите число n - число узлов ');
     readln(N);
     n:=n-1;
     if n<0 then begin
                      textcolor(4);
                      write('Incorrect input data');
                      readkey;
                      goto theend;
                 end;
     CalcXi;
     proizvodnie;
     writeln;
     textcolor(10);
     writeln('  Узловые точки    З**че*ие ф-ции      З**че*ие ИМЛ');
     textcolor(7);
     writeln('--------------------------------------------------------');
     for l:=0 to N do
         begin
              write('|  ',XMas[l]:8:3,'     |',myfunc(XMas[l]):15:3,'    |',iml(XMas[l]):15:3,'   |');
              writeln
         end;
     writeln(#10,'Для продолже*ия **жмите к*кую-*ибудь кл*вишу...');
     readkey;
     writeln;
     textcolor(14);
     writeln('  Погреш*ость           Y                    X');
     textcolor(7);
     writeln('--------------------------------------------------------');
     writeln('| Пр*ктическ*я  |',prakt_pogr:15:3,'    |    ',xmax:8:3,'      |');
     writeln('| Теоретическ*я |',theory_pogr:15:3,'    |   ');
     writeln(#10,'Для продолже*ия **жмите к*кую-*ибудь кл*вишу...');
     readkey;
{Д***ый блок отвеч*ет з* построе*ие гр*фиков}
     ymtab:=700;
     xmtab:=12;
     graphini;
again:
     cleardevice;
     osi;
     setcolor(13);
     moveto((xmtab*a+320),240-round(myfunc(a)/ymtab));
     for x:=a to b do
         begin
              lineto((xmtab*x+320),240-round(myfunc(x)/ymtab));
         end;
     setcolor(14);
     moveto((xmtab*a+320),240-round(iml(a)/ymtab));
     for x:=a to b do
         begin
              lineto((xmtab*x+320),240-round(iml(x)/ymtab));
         end;
dont:
     readkey;
     ch:=readkey;
     case ch of
          #72:begin
                   if ymtab<=100 then goto dont
                                 else ymtab:=ymtab-100;
                   goto again
              end;
          #80:begin ymtab:=ymtab+100; goto again end;
          #75:begin
                   if xmtab<=1 then goto dont
                               else xmtab:=xmtab-1;
                   goto again
              end;
          #77:begin xmtab:=xmtab+1; goto again end;
     end;
     closegraph;
theend:
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
26.12.2015, 13:12
Ответы с готовыми решениями:

Интерполяция Лагранжа
Program lagranzh; uses Crt; const m=5; type k=array of real; function c(x:real):real;...

Интерполяция полиномом Лагранжа и кусочная интерполяция
столкнулась с такой проблемой: написала интерполяцию Лагранжа x=; y=2*cos(x); function...

Интерполяция полиномом Лагранжа
Построить интеропляционный полином Лагранжа по следующим данным : x0=191 y0=472 x1=121 y1=387...

Интерполяция полиномом Лагранжа
Написал программу для интерполяции функции полиномом Лагранжа. Получается неправильно. Помогите...

0
26.12.2015, 13:12
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
26.12.2015, 13:12
Помогаю со студенческими работами здесь

Интерполяция полиномом Лагранжа
Функция у = f(x) задана в табличной форме: x=0; y=1.763; x=0.2; y=1.917; x=0.4; y=2.143; ...

Интерполяция полиномом Лагранжа
народ, хелп плиз!! :help: парюсь уже 2ю неделю(( :help: суть собссно в следующем - надо...

Интерполяция полиномом Лагранжа
Добрый день Я все пытаюсь разобраться с полиномом Лагранжа и столкнулся с очень интересным...

Численная интерполяция полиномом Лагранжа
Вот получил задание, на выполнение интерполяции. Помогите. Задание X: | 1 | 2 | 3 | 5 | 6 Y:...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru