Квашнин С.Е. - Сборник научных программ на Паскале, страница 4
Описание файла
PDF-файл из архива "Квашнин С.Е. - Сборник научных программ на Паскале", который расположен в категории "". Всё это находится в предмете "основы медицинской акустики" из 8 семестр, которые можно найти в файловом архиве МГТУ им. Н.Э.Баумана. Не смотря на прямую связь этого архива с МГТУ им. Н.Э.Баумана, его также можно найти и в других разделах. Архив можно найти в разделе "книги и методические указания", в предмете "основы медицинской акустики" в общих файлах.
Просмотр PDF-файла онлайн
Текст 4 страницы из PDF
Минимизация функции нескольких переменных методомпрямого поиска (методом конфигураций) [E4]Процедура directsearch (direct- прямой, search- поиск) может быть использованадля поиска минимума функции s от k переменных. Авторы алгоритма 178указывают, что применение этой процедуры рассматривается в работе Р.Хука иТ.Дживса [10i]. Здесь используются такие же обозначения, какие приняты в"Приложении В" указанной работы, за исключением очевидных модификаций,соответствующих требованиям сокращенного АЛГОЛа.
См. также работу Дж.Уайлда [45,c.202].Расшифровка параметров:s- процедура, вычисляющая минимизируемую функцию s(psi).k- количество переменных функции s.d- доля начальных значений аргументов, используемая как начальныйразмер шага. На выходе из процедуры d- это конечный размер шага.rho- множитель, уменьшающий размер шага.delta- минимально допустимый размер шага (процедура заканчивается,если размер шага становится меньше delta).max- максимально допустимое количество вычислений функции. На выходе изпроцедуры max- это фактически затраченное количество вычислений функции.29psi[1:k]- на входе в процедуру- эта начальная точка поиска.
На выходе- этонайденная точка минимума, т.е. совокупность значений аргументов, при которойфункция s имеет минимум.spsi- на выходе из процедуры- это значение функции s в точке psi[1:k].min- наименьшая степень числа 10, представимая в данной машине.procedure directsearch (k:integer; rho,delta,min: real;var d,spsi : real; max: integer;var psi);{ algorithm 178b , adupted by Kvashnin S.E.
}label 1,2,10,1000;var sphi,ss,theta : real;i,eval :integer;boll :Boolean;s1 :massiv;{ array[1..nn] of real; }phi : array[1..(2*MaxInt) div SizeOf(double)] of double absolute phi1;{procedure test(var bol: Boolean);begin bol:=false;if eval<max then eval:=eval+1 else begin bol:=true; write('11') endgoto 1000}end;procedure ee(var bolle: Boolean);beginfor i:=1 to k dobegin phi[i]:=phi[i]+s1[i]; bolle:=false;sphi:=s(phi); eval:=eval+1;if sphi<ss then ss:=sphi elsebegin s1[i]:=-s1[i];phi[i]:=phi[i]+2.0*s1[i];test(boll); if boll then bolle:=true;sphi:=s(phi);if sphi<ss then ss:=sphi elsephi[i]:=phi[i]-s1[i]endend;{i}end;{ee}{start:}beginfor i:=1 to k dobegin s1[i]:=d*abs(psi[i]);if s1[i]<min then s1[i]:=dend;spsi:=s(psi); eval:=1;1: ss:=spsi;for i:=1 to k do phi[i]:=psi[i];ee(boll);if boll then goto 1000;{writeln(' pass 1-2');}if ss<spsi thenbegin2:for i:=1 to k dobegin30if (phi[i]>psi[i])=(s1[i]<0) thens1[i]:=-s1[i];theta:=psi[i]; psi[i]:=phi[i];phi[i]:=2.0*phi[i]-thetaend; {i}spsi:=ss; test(boll); if boll then goto 1000; ss:=s(phi);sphi:=ss; ee(boll); if boll then goto 1000;if ss>= spsi then goto 1;for i:=1 to k doif abs(phi[i]-psi[i])>0.5*abs(s1[i]) then goto 2end;if d>=delta thenbegin if eval>max then goto 1000;d:=rho*d;for i:=1 to k do s1[i]:=rho*s1[i];goto 1end;{if d}1000: max:=evalEND;Пример программы:program test;Uses Crt;const k=2; rh0=0.1; delta=0.001; min=1e-307;type massiv= array[1..k] of real;var d,spsi : real;i,j,max : integer;psi : massiv;function S(psi:massiv):real;begins:=sqr(psi[1]-2) + sqr(psi[2]-5);end;{-----------------------------------------------------------------------}{$I DIRS178.PAS}{--- ----------------------------------------------------------}begin {Main program }ClrScr;max:=1000;d:=0.2;psi[1]:=0.1; psi[2]:=0.3;directsearch(k,rh0,delta,min,d,spsi,max,psi);writeln(psi[1],psi[2]);end.АЛГОРИТМ 182б.
Вычисление интентеграла по Симпсону с заданной меройпогрешности [D1]Процедура- функция simpson приближенно вычисляет интеграл от функции f(x)в пределах от а до b методом Симпсона с заданной допустимой меройпогрешности eps.31Данный алгоритм является нерекурсивным вариантом алгоритма 145б.Использованный здесь метод преобразования рекурсивной процедуры внерекурсивную может применятся для широкого класса алгоритмов.function simpson(a,b,eps: RealType): RealType;{-----------------------------------------------------------------------------}{ Algorithm 182 b, Addupted by S.Kvashnin, 10.03 1987 }label 1,2,3,11,12,13;varabsarea,est,fa,fm,fb,da,sx,est1,sum,f1 : RealType;l, rt: integer;dx,epsp,x2,x3,f2,f3,f4,fmp,fbp,est2,est3 : array[1..30] of RealType;pval: array[1..30,1..3] of RealType;rtrn: array[1..30] of integer;begin1: l:=0; da:=b-a;absarea:=1.0; est:=1;fa:=FexSim(a); fb:=fexSim(b);fm:=4.0*fexSim((a+b)/2.0);2: l:=l+1; dx[l]:=da/3.0;sx:=dx[l]/6.0; f1:=4.0*fexSim(a+dx[l]/2.0);x2[l]:=a+dx[l]; f2[l]:=fexSim(x2[l]);x3[l]:=x2[l]+dx[l];f3[l]:=fexSim(x3[l]);epsp[l]:=eps; f4[l]:=4.0*fexSim(x3[l]+dx[l]/2.0);fmp[l]:=fm; fbp[l]:=fb;est1:=(fa+f1+f2[l])*sx;est2[l]:=(f2[l]+f3[l]+fm)*sx;est3[l]:=(f3[l]+f4[l]+fb)*sx;sum:=est1+est2[l]+est3[l];absarea:=absarea-abs(est)+abs(est1)+abs(est2[l])+abs(est3[l]);if (abs(est-sum)<=epsp[l]*absarea) and (est<>1.0) or (l>=30) thenbegin3:l:=l-1;rt:=rtrn[l];pval[l,rt]:=sum;if rt=1 then goto 11;if rt=2 then goto 12;if rt=3 then goto 13;end;rtrn[l]:=1; da:=dx[l];fm:=f1; fb:=f2[l];eps:=epsp[l]/1.7; est:=est1;goto 2;11: rtrn[l]:=2; da:=dx[l];fa:=f2[l]; fm:=fmp[l]; fb:=f3[l];eps:=epsp[l]/1.7;est:=est2[l]; a:=x2[l];goto 2;12: rtrn[l]:=3; da:=dx[l];fa:=f3[l]; fm:=f4[l]; fb:=fbp[l];eps:=epsp[l]/1.7; est:=est3[l]; a:=x3[l];goto 2;13: sum:=pval[l,1]+pval[l,2]+pval[l,3];if l> 1 then goto 3;simpson:=sum;32end;Пример программы:program SimpsonT;var aa,bb, epss,s : real;{---------------------------------------------------------------------------}function FexSim(x: real): real; {It's your subprogram ...
! }beginFexSim:=sin(x);end;{--------------------------------------------------------------------------}{$I SIMPSON.PAS}beginwriteln('input the data - a,b,eps');readln(aa,bb,epss);s:=simpson(aa,bb,epss);writeln(aa,bb,epss,s);end.АЛГОРИТМ № 189б. Сглаживание по пяти точкам [E3]Процедура smooth189 (smooth-сглаживать) использует пятиточечные формулыГрама (Gram) третьей степени, описанные Гилдебрандом в работе [12i], длясглаживания последовательности n значений функции (при равноотстоящихзначениях аргумента ), записанных в массиве x[1:n]. Если обращение к процедурепроизводится с n<5, то происходит выход к глобальной метке signal189.{ 189b Kvashnin S.E., Modify 26.05.91 }procedure Smooth189KW(n,{ количество точек во входном массиве x }s: integer;hf: RealType;var NumPoint : integer;var x1,y1 ;var signal : boolean);vari,j,Step,Counter : integer;h,k,s0,s1,s2: RealType;x : array[1..(2*MaxInt) div SizeOf(RealType)] of RealType absolute x1;y : array[1..(2*MaxInt) div SizeOf(RealType)] of RealType absolute y1;beginsignal:=false;NumPoint:=1;if (hf < 0) or (hf >10) then EXIT;if (n < 6) or (s < 1) or (s > 100) then EXIT;for i:=3 to n-2 do33begins0:=(-3*x[i-2]+12*x[i-1]+17*x[i]+12*x[i+1]-3*x[i+2])/35.0;s1:=(-2*x[i-2]-x[i-1]+x[i+1]+2*x[i+2])*0.1;s2:=(2*x[i-2]-x[i-1]-2*x[i]-x[i+1]+2*x[i+2])/14.0;Step:=s; k:=-1; h:=1.0/(s-1);if i=3 then begin k:=-2; step:=2*s end;if i=n-2 then step:=round((3+hf)*s)+1;for j:=1 to step dobeginy[NumPoint]:=s0+k*s1+k*k*s2;k:=k+h;NumPoint:=NumPoint+1;end;end; {i}signal:=true;NumPoint:=NumPoint-2;end; {Smooth189KW }Пример программы:program Smooth;USES Crt,Graph;type RealType = double;mass_n_Sm = array[1..100] of RealType;mass_SxN = array[1..1000] of RealType;varihY,ff:RealType;ys2,xs2:longint;yscreen,xscreen:longint;npOld:integer;numY,numX:integer;XUp,YUp,XDw,YDw:longint;GraphDriver,GraphMode :integer;nn,s,i,np : integer;hf: RealType;signal : boolean;x: mass_n_Sm;y: mass_SxN;{$I SMTH189.pas}{-----------------------------------------------------}beginClrScr;nn:=80; s:=5; hf:=0;randomize;for i:=0 to nn dobeginff:=random(i);writeln(ff);x[i+1]:=10.0*(cos(1.0*i/nn*3.141593/1.0)+0.001*ff);end;{write('n='); readln(nn);write('s='); readln(s);34{for i:=1 to nn dobegin write(' i=',i:2,' x='); read(x[i]); end; }writeln('--------------------------------------------------');Smooth189KW(nn,s,hf,np, x, y,signal);if not signal then Halt(1);writeln('--------------signal=',signal,' ---------------------------');for i:=1 to np dowriteln(i,y[i]); }{--------------------initialization Graphic-------------------------------}DetectGraph(GraphDriver,GraphMode);InitGraph(GraphDriver,GraphMode,'\tp\graph');if GraphResult < 0 then Halt(1);OutText('This is Smooth Test for Random cos ');for i:=1 to np doPutPixel(round(i/np*700),round(y[i]*10)+120,1);for i:=1 to nn doPutPixel(round(i/nn*700),round(x[i]*10)+100,1);readln;ClearDevice;CloseGraph;{---------------------------------------------------------------------}end.АЛГОРИТМ №195б.
