четвертая - схема Горнера вычисления полинома n-ой степени.
Код: Выделить всё
uses crt;
var
i,n,errcode:integer;
x,s,a:real;
q,w,e,r,t,y:string;
begin clrscr;
Writeln('Shema Gornera dlya resheniya Polinoma');
writeln;
writeln('Vvedite X');
readln(q);
val(q,x,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
writeln('Vvedite kolichestvo koeffitsientov');
readln(w);
val(w,n,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
writeln('Vvedite ',n,' koeffitsient' );
readln(e);
val(e,a,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
s:=x*a;
i:=n-1;
repeat
writeln('Vvedite ',i,' koeffitsient' );
readln(e);
val(e,a,errcode); if errcode<>0 then begin writeln('Tak Nel`zya!!! Najmite ENTER chtobi viyti'); readln;exit;end else begin
s:=(s+a)*x;
i:=i-1;end
until i=0;
writeln('Vvedite 0 koeffitsient' );
readln(a);
s:=s+a;
writeln('Summa Mnogochlena ravna ',s:12:2);
writeln('Najmite Enter chtobi viyti');
readln;
end;end;end;
end.
пятая, поиск седловой точки в прямоугольной вещественной матрице (элемент матрицы максимальный в своей строке и минимальный в столбце
Код: Выделить всё
uses crt;
const m=3;
n=3;
var
a:array[1..m,1..n] of integer;
u:array[1..m,1..n] of string;
i,w,j,r,z,t,k,errcode:integer;
BEGIN clrscr;
writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++');
writeln(' Programma poiska sedlovoy tochki v matrice');
writeln('+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++');
writeln;
writeln(' Vvedite elementi matrici');
writeln;
for i:=1 to m do
begin
for j:=1 to n do
begin Writeln('Vvedite a[',i,',',j,']');
readln(u[i,j]);
val(u[i,j],a[i,j],errcode);
if errcode<>0 then
begin
writeln('Eta programma rabotayet tolko s chislami,najmite ENTER chtobi viyti');
readln;exit;
end;
end;
end;
w:=0;
for i:=1 to m do
begin
z:=a[i,1]; k:=1; t:=i;
for j:=1 to n do
begin
if z>=a[i,j] then begin z:=a[i,j]; k:=j; end;
end;
r:=z;
for i:=1 to m do begin
if r<=a[i,k] then r:=a[i,k];
end;
if r=z then
begin writeln('Sedlovaya tochka etoy matritsi ravna ',r,', nahoditsya v ',t,' stroke i v ',k,' stolbce');
w:=w+1;
end; i:=t;
end;
if w=0 then begin writeln('Sedlovih tochek net, najmite ENTER chtobi viyti'); end;
if w>1 then begin clrscr; writeln('Sedlovaya tochka mojet bit tolko odna, najmite ENTER chtobi viyti'); end;
readln;
end.
шестая -метод половинного деления для поиска в упорядоченной таблице
Код: Выделить всё
uses crt;
label 1,2,3,4;
var
provera,i,j,n,m:integer;
a:array [1..100] of string;
y,s:string;
procedure vvod;
begin
writeln;
writeln('Programma poiska elementa v massiva metodom polovinnogo deleniya');
writeln;
write(' Vvedite kolichestvo elementov massiva ');
readln(n);
for i:=1 to n do
begin
write(' Vvedite ',i,'-y element ');
readln(a[i]);
end;
end;
procedure Sortirovka;
var k: integer;
begin
writeln (' Proizvedena sortirovka');
for i:=1 to n-1 do
begin
for j:=i to n do
begin
if a[i]>=a[j] then
begin
y:=a[i];
a[i]:=a[j];
a[j]:=y;
end;
end;
end;
end;
procedure vivod;
begin
for i:=1 to n do writeln(' ',i,'-y element raven` ', a[i]);
end;
procedure poisk;
label 1,2,3,4;
var
k:integer;
netu:boolean;
begin
writeln;
Write(' Chto ishem??? ');
readln(s);
if s<>'' then begin
for i:=1 to n do begin if a[i]=s then begin
k:=n;
1: k:=k div 2;
2: if a[k]=s then begin writeln;writeln(' Zaproshenniy element ', a[k],' nayden v stroke ',k);
readln;halt(1);end else
if a[k]>s then goto 1 else
begin
if k=n-1 then k:=n;
k:=k+((n-k) div 2); goto 2;
end;
end;
netu:=false;
provera:=1;
end;
end;
end;
procedure net_takovo;
begin if provera<>1 then writeln;writeln(' Net takogo'); end;
BEGIN clrscr;
vvod;
sortirovka;
vivod;
poisk;
net_takovo;
readln;
halt(1);
end.