28. Введите структуру, описывающую концепцию автомобиля, в полях которой указаны дата регистрации, марка автомобиля, год выпуска, цвет, номер. Создайте и протестируйте следующую функцию: в) поиск любого из указанных свойств машины.

Program Parabolas;
Uses Crt;
Var
  a, b, c, d, m, n, dis, x1, x2 : real;
begin
  writeln('Введите коэфициенты первой параболы');
  write('A=');readln(a);
  write('B=');readln(b);
  write('C=');readln(c);
  writeln('Введите коэфициенты второй параболы');
  write('D=');readln(d);
  write('M=');readln(m);
  write('N=');readln(n);
  writeln('*** alphaues is thinking... ***');
  if a=d then
    if b=m then
      if c=n then
        writeln('Параболы совпадают!')
      else
        writeln('Параболы не пересекаются!')
    else
      begin
        x1:=(c-n)/(b-m);
        writeln('Параболы пересекаются в 1-й точке: ',x1,' ',a*x1*x1+b*x1+c);
      end
  else
    begin
      dis:=(b-m)*(b-m)-4*(a-d)*(c-n);
      if dis>0 then
        begin
          x1:=((m-b)+sqrt(dis))/(2*(a-d));
          x2:=((m-b)-sqrt(dis))/(2*(a-d));
          writeln('Параболы пересекаются в 2-x точкax: ');
          writeln(x1,' ',a*x1*x1+b*x1+c);
          writeln(x2,' ',a*x2*x2+b*x1+c);
        end
      else
        if dis=0 then  
        begin
          x1:=(m-b)/(2*(a-d));
          writeln('Параболы пересекаются в 1-й точке: ',x1,' ',a*x1*x1+b*x1+c);
        end
        else writeln('Параболы не пересекаются!');
   end;
end.   

 

Program MassXY;
uses crt;
const n = 20;
var
  x,y:array [1..n] of real;
  i,k, maxnum, minnum:integer;
  max, min,temp: real;
begin
  k:=1;
  randomize;
  for i:=1 to n do
    begin
      x[i]:=random(101)-50;
      if (1<=x[i]) and (x[i]<=2) then
        begin
          y[i]:=x[i];
          k:=k+1;
        end;
    end;
  writeln('*** alphaues is thinking... ***');
  max:=y[1];
  maxnum:=1;
  min:=y[1];
  minnum:=1;
  for i:=1 to k do
    begin
      if max<y[i] then
        begin
          max:=y[i];
          maxnum:=i;
        end;
      if min>y[i] then
        begin
          min:=y[i];
          minnum:=i;
        end;      
    end;
    temp:=y[maxnum];
    y[maxnum]:=y[minnum];
    y[minnum]:=temp;
  writeln('Массив Y состоит из ',k,' элементов:');
  for i:=1 to k do
    write(y[i],'  ');
end.

Program MatrixP;
uses crt;
const n=10;
const m=8;
var
  p:array[1..n,1..m] of integer;
  sum:array[1..n] of integer;
  st:array[1..m] of integer;
  i,j,tempsum,min,max,minnum,maxnum : integer;
begin
  Randomize;
  {ввод и вывод матрицы}
  writeln('Начальная матрица:');
  for i:=1 to n do
    begin
      for j:=1 to m do
        begin
          p[i,j]:= Random(100);
          write(p[i,j]:5);
        end;
       writeln;
    end;
  writeln('*** alphaues is thinking... ***');
  {нахождение сумм строк}
  for i:=1 to n do  
    begin
      tempsum:=0;
      for j:=1 to m do
        tempsum:=tempsum+p[i,j];
      sum[i]:=tempsum;
    end;
  maxnum:=1;
  tempsum:=sum[1];
  for i:=1 to n do  
    if tempsum>sum[i] then
      begin
        tempsum:=sum[i];
        minnum:=i;
      end;  
  writeln('Min сумма в ',minnum,'-й строке: ',sum[minnum]);
  {нахождение max элемента матрицы}
  max:=p[1,1];
  for i:=1 to n do
    for j:=1 to m do
      begin
        if max<p[i,j] then max:=p[i,j];
        maxnum:=i;
      end;
  writeln('Max элемент ',max,' находится в ',maxnum,'-й строке');
  for j:=1 to m do
    begin
      st[j]:=p[maxnum,j];
      p[maxnum,j]:=p[minnum,j];
      p[minnum,j]:=st[j];
    end;
  {вывод матрицы}
  writeln('Результат:');
  for i:=1 to n do
    begin
      for j:=1 to m do
        begin
          write(p[i,j]:5);
        end;
       writeln;
    end;
 end.

//Когда Глеб расстроился
//Pascal ABC.NET 3.1 сборка 1256

Var
 a,b,c,d,e:real;
 
procedure cube(a,b,c,d,e:real);
Var
 p,q,delta,phi,i:real;
 y:array[1..3] of real;
begin
p:=(3*a*c-sqr(b))/(3*sqr(a));
q:=(2*power(b,3)-9*a*b*c+27*sqr(a)*d)/(27*power(a,3));
delta:=power(q/2,2)+power(p/3,3);
if delta<0 then
 begin
  if q<0 then
   phi:=arctan(sqrt(-delta)/(-q/2));
  if q>0 then
   phi:=arctan(sqrt(-delta)/(-q/2))+pi;
  if q=0 then
   phi:=pi/2;
  y[1]:=2*sqrt(-p/3)*cos(phi/3);
  y[2]:=2*sqrt(-p/3)*cos(phi/3+(2*pi)/3);
  y[3]:=2*sqrt(-p/3)*cos(phi/3+(4*pi)/3);
  var x:=seq(y[1]-b/(3*a),y[2]-b/(3*a),y[3]-b/(3*a));
  write(x.where(x -> x<>e).where(x -> frac(x)=0).where(x -> x>=0).Where(x -> x<=1000).Distinct.Count);
 end;
if delta>0 then
 begin
  var arsom:=range(0,1000).Where(x->(a*power(x,3)+b*x*x+c*x+d)/(x-e)=0);
  write(arsom.Count);
  {Мы не виноваты, Паскаль не может в комплексные числа}
 end;
if delta=0 then
 begin
  y[1]:=2*power(-q/2,1/3);
  y[2]:=-power(-q/2,1/3);
  var x:=seq(y[1]-b/(3*a),y[2]-b/(3*a));
  write(x.where(x -> x<>e).where(x -> frac(x)=0).where(x -> x>=0).Where(x -> x<=1000).Distinct.Count);
 end;
end;

procedure square(a,b,c,e:real);
Var
 d:real;
begin
d:=sqr(b)-4*a*c;
if d<0 then writeln('0');
if d>0 then
 begin
  var x:=arr((-b+sqrt(d))/(2*a),(-b-sqrt(d))/(2*a));
  write(x.where(x -> x<>e).where(x -> frac(x)=0).where(x -> x>=0).Where(x -> x<=1000).Distinct.Count);
 end;
if d=0 then
 begin
  var x:=arr(-b/(2*a));
  write(x.where(x -> x<>e).where(x -> frac(x)=0).where(x -> x>=0).Where(x -> x<=1000).Distinct.Count);
 end;
end;

procedure common(a,b,e:real);
begin
 var x:=arr(-b/a);
 write(x.where(x -> x<>e).where(x -> frac(x)=0).where(x -> x>=0).Where(x -> x<=1000).Distinct.Count);
end;

procedure awfulvar(e:real);
begin
 if (e>=0) and (e<=1000) then writeln('1000') else writeln('1001');
end;

procedure otherawfulvar(e:real);
begin
 if e<>0 then writeln('1') else writeln('0');
end;

begin
read(a,b,c,d,e);
if (a<>0) and (b<>0) then cube(a,b,c,d,e);
if (a=0) and (b<>0) then square(b,c,d,e);
if (a=0) and (b=0) and (c<>0) and (d<>0) then common(c,d,e);
if (a=0) and (b=0) and (c=0) and (d=0) then awfulvar(e);
if (a=0) and (b=0) and (c<>0) and (d=0) then otherawfulvar(e);
if (a=0) and (b=0) and (c=0) and (d<>0) then writeln('0');
end.

Пример ввода:
1
1
1
1
1
Пример вывода:
0