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.