01 семестр / К экзамену-зачёту / Все задачи с экзамена в формате PAS / Alex / MODULE

Unit module;
INTERFACE
Uses CRT;
Const
nefiga=3;
type
masiv=array[1..10] of integer;
mas_r=array[1..10,1..10]of real;
mas_i=array[1..10,1..10]of integer;
func=function(x:real):real;
mas=array[1..100] of real;
var
t:array[1..30] of real;
i,j,k,n,m,c:integer;
d0:mas_i;
d1:mas_r;
ni,ki,shag:real;
f:file of real;
kol,num:integer;
x,min:real;
a:mas;
_x,_y:masiv;
i_no_ne_I,j_no_ne_J,kadr1,kadr2 :integer;
pridurok :real;

Procedure Fuck;
Procedure Ya_dostau_iz_shirokih_shtanin_BIG_PROCEDURE(x,y:masiv;var pridurok:real; var kadr1,kadr2:integer);
Procedure Good(var mas;c,n,m:integer);
Procedure Kruto(ni,shag:real;kol:integer;f:func;var a:mas;n:integer);
Procedure Kleuvo(a:mas;n:integer);


IMPLEMENTATION


Procedure Ya_dostau_iz_shirokih_shtanin_BIG_PROCEDURE(x,y:masiv;var pridurok:real; var kadr1,kadr2:integer);
begin
pridurok:=sqrt((_x[1]-_x[2])*(_x[1]-_x[2])+(_y[1]-_y[2])*(_y[1]-_y[2]));
kadr1:=1; kadr2:=2;
For i_no_ne_I:=1 to nefiga Do
For j_no_ne_J:=1 to nefiga Do
if (sqrt((_x[i_no_ne_I]-_x[j_no_ne_J])*(_x[i_no_ne_I]-_x[2])+
(_y[i_no_ne_I]-_y[j_no_ne_J])*(_y[i_no_ne_I]-_y[j_no_ne_J]))<pridurok)
and (sqrt((_x[i_no_ne_I]-_x[j_no_ne_J])*(_x[i_no_ne_I]-_x[2])+
(_y[i_no_ne_I]-_y[j_no_ne_J])*(_y[i_no_ne_I]-_y[j_no_ne_J]))<>0)
then begin pridurok:=sqrt((_x[i_no_ne_I]-_x[j_no_ne_J])*(_x[i_no_ne_I]-_x[2])+
(_y[i_no_ne_I]-_y[j_no_ne_J])*(_y[i_no_ne_I]-_y[j_no_ne_J]));
kadr1:=i_no_ne_I; kadr2:=j_no_ne_J end;
end;

Procedure Good(var mas;c,n,m:integer);
var
min0:integer;
min1:real;
a0:array[1..10]of integer;
a1:array[1..10]of real;
begin
if c=0 then
begin
for i:=1 to n do
a0[i]:=1;
for i:=1 to n do
for j:=1 to m do begin
a0[i]:=a0[i]*mas_i(mas)[i,j]
end;
min0:=a0[1];
for i:=1 to n do
if min0>a0[i] then min0:=a0[i];
writeln('MIN Їа®Ё§. бва®Є 楫. ¬ ваЁжл= ',min0);
end
else begin
for i:=1 to n do
a1[i]:=1;
for i:=1 to n do
for j:=1 to m do begin
a1[i]:=a1[i]*mas_r(mas)[i,j]
end;
min1:=a1[1];
For i:=1 to n do
if min1>a1[i] then min1:=a1[i];
writeln('MIN Їа®Ё§. бва®Є ўҐй. ¬ ваЁжл= ',min1:5:2);
end;
end;

Procedure Kruto(ni,shag:real;kol:integer;f:func;var a:mas;n:integer);
begin
x:=ni;n:=0;
For i:=1 to kol Do begin
if f(x)*f(x+shag)<0 then begin min:=(2*x+shag)/2;n:=n+1;a[n]:=min;
end;
x:=x+shag;
end;
num:=n;
end;

Procedure Kleuvo(a:mas;n:integer);
begin
min:=1;
For i:=1 to n do
if a[i]>0 then min:=a[i];
if min=-1 then begin
writeln('Џ®«®¦ЁвҐ«м­ле Є®а­Ґ© ­Ґв');exit;
end;
for i:=1 to n do
if (a[i]<min) and (a[i]>=0) then min:=a[i];
writeln;
writeln('x=',min:4:2);
end;


Procedure Fuck;
var
t:array[1..30] of real;
begin
assign(f,'f.dat');
reset(f);
writeln('€б室­л© ¬ ббЁў:');
while not eof(f) do
begin
read(f,t[i]);
Writeln(t[i]:3:0);
end;
close(f);

writeln('ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў:');
reset(f);
while not eof(f) do
begin
read(f, t[i]);
if t[i]<0
then
write(t[i]:3:0);end;
for i:=1 to n do begin
if t[i]>=0 then
write('ЋваЁж вҐ«м­ле н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ ­Ґв!');end;
close(f);
writeln;
end;



end.