В одномерных массивах А[1..N] и B[1..M] определить количество чисел – палиндромов ( т.е. таких, десятичная запись которых читается одинаково слева направо и справа налево.). Тот массив, где количество таких чисел больше, рассортировать по возрастанию, а другой – по убыванию — Pascal(Паскаль)

uses crt;
const nmax=100;
type mas=array[1..nmax] of integer;
//ввод массивов
procedure Vvod(var v:mas;var x:byte;c:char);
var i:byte;
begin
repeat
write('Размер массива ',c,' до ',nmax,'=');
readln(x);
until x in [1..nmax];
writeln('Введите ',x,' элементов массиваа ',c);
for i:=1 to x do
 begin
  write('el[',i,']=');
  readln(v[i]);
 end;
clrscr;
end;
//вывод на экран
procedure Vyvod(var v:mas;x:byte;c:string);
var i:byte;
begin
writeln('Вектор ',c);
for i:=1 to x do
write(v[i],' ');
writeln;
end;
//поиск палиндромов
function Palindrom(n:integer):boolean;
var m,p:longint;
    i,k:integer;
    begin
m:=n;
p:=0;
while m>0 do
  begin
    i:=m mod 10;
    p:=p*10+i;
    m:=m div 10;
  end;
if p=n then Palindrom:=true
else Palindrom:=false;
end;
//количество палиндромов
function KolPal(v:mas;x:byte):byte;
var i,k:byte;
begin
k:=0;
for i:=1 to x do
if Palindrom(v[i]) then k:=k+1;
KolPal:=k;
end;
//сортировка по возрастанию
procedure SortVoz(var v:mas;x:byte);
var i,j:byte;
   b:integer;
begin
for i:=1 to x-1 do
for j:=i+1 to x do
if v[i]>v[j] then
 begin
  b:=v[i];
  v[i]:=v[j];
  v[j]:=b;
 end;
end;
//сортировка по убыванию
procedure SortUb(var v:mas;x:byte);
var i,j:byte;
    b:integer;
begin
for i:=1 to x-1 do
for j:=i+1 to x do
if v[i]<v[j] then
 begin
  b:=v[i];
  v[i]:=v[j];
  v[j]:=b;
 end;
end;
 
var a,b:mas;
    n,m,ka,kb:byte;
begin
clrscr;
Vvod(a,n,'A');
Vvod(b,m,'B');
Vyvod(a,n,'A');
ka:=KolPal(a,n);
writeln('Количество палиндромов=',ka);
writeln;
Vyvod(b,m,'B');
kb:=KolPal(b,m);
writeln('Количество палиндромов=',kb);
writeln;
if ka>kb then
 begin
  writeln('В массиве А палиндромов больше');
  SortVoz(a,n);
  SortUb(b,m);
 end
else  if kb>ka then
 begin
  writeln('В массиве B палиндромов больше');
  SortVoz(b,m);
  SortUb(a,n);
 end;
if ka=kb then writeln('Палидромов поровну, сортировок нет')
else
 begin
  Vyvod(a,n,'A');
  Vyvod(b,m,'B');
 end;
readln
end.

Leave a Comment

8 + 2 =