Народ помогите пожалста:
Дан массив содержащий N элементов(N не менее 10).Написать подпрограмму выполняющюю след действея:
определение элемента, значение которого встречается в массиве наибольшее число раз.

Ну и в чем трабл?
Или тебе готовая прога нужна? Тогда это в другой раздел.
Ладно....массив чего? (булеан, стринг, число)
Длинна элмента? (1-н символ, 2-а, 3-и)?

Наиболее просто отсортить и посчитать. Хотя можно обойтись и без сорта.

Смотри не могу понять в чем ошибка.(мне там ещё нужно было элементы местами поменять
1-2;3-4 и тд)

program Project1;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
N=16;
var
k:integer;
a:array[1..N] of integer;
i:integer;
buf:integer;
c:integer;
S:integer;
c1:integer;
S1:integer;
j:integer;
begin


writeln('vvedite k');
readln(k);
if k>10 then
begin
randomize;
for i:=1 to N do
begin
a[i]:=random(k);
write('',a[i]:3);
end;
readln
end
else
begin
writeln('nepravilno');
exit;

end;
writeln('----------------------');

for i:=1 to N do
begin
if Odd(i) then
begin
buf:=a[i];
a[i]:=a[i+1];
end
else
a[i]:=buf;
end;
for i:=1 to N do
begin
write('',a[i]:3);
read;
end;
writeln(' ');

S:=0;
S1:=0;
c:=a[1];

for i:=1 to N do

if a[i]=c then

S:=S+1;


for i:=1 to N do


c1:=a[i];
for j:=1 to N do

a[j]:=a[5];


writeln('',a[i]:3);
readln;











end.

а разве так можно

Код

write('',a[i]:3);

bivis
вроде то?
конечно не оптимально и не красиво, но работает (лень заморачивать)

Код

program Project2; {$APPTYPE CONSOLE} uses  SysUtils; const  N=16; var  k : integer;  a : array[1..N] of integer;  b : array[1..N] of integer;  i : integer;  buf : integer;  c : integer;  S :  integer;  c1 : integer;  S1 : integer;  j : integer;  lCountEqualItems, lSaveItem, lSaveCountEqualItems : integer; begin  writeln('vvedite k');  readln(k);  if k > 10 then  begin    randomize;    for i := 1 to N do    begin      a[i] := random(k);      write('',a[i]:3);    end;    readln  end  else  begin    writeln('nepravilno');    exit;  end;  writeln('----------------------');  for i := 1 to N do    for j := i to N do      if a[j] < a[i] then      begin        buf := a[i];        a[i] := a[j];        a[j] := buf;      end; {  for i := 1 to N do    write('',a[i]:3); }  for i := 1 to N do    b[i] := a[i];  writeln('');  writeln('----------------------');  lCountEqualItems := 1;  buf := a[1];  for i := 2 to N do    if a[i] = buf then      Inc(lCountEqualItems)    else begin      if lCountEqualItems >= lSaveCountEqualItems then      begin        lSaveItem := buf;        lSaveCountEqualItems := lCountEqualItems;      end;      buf := a[i];      lCountEqualItems := 1;    end;    write('max Number in array = ',lSaveItem);    for i := 1 to N do    begin      if b[i] mod 2 = 0 then      begin        buf := b[i];        b[i] := b[i - 1];        b[i - 1] := buf;      end;    end;  writeln('');  writeln('----------------------');  for i := 1 to N do    write('',b[i]:3);  readln; end.

Добавлено @ 14:17
сорри ошибка там, вот так:

Код

program Project2; {$APPTYPE CONSOLE} uses  SysUtils; const  N=16; var  k : integer;  a : array[1..N] of integer;  b : array[1..N] of integer;  i : integer;  buf : integer;  c : integer;  S :  integer;  c1 : integer;  S1 : integer;  j : integer;  lCountEqualItems, lSaveItem, lSaveCountEqualItems : integer; begin  writeln('vvedite k');  readln(k);  if k > 10 then  begin    randomize;    for i := 1 to N do    begin      a[i] := random(k);      write('',a[i]:3);    end;    readln  end  else  begin    writeln('nepravilno');    exit;  end;  for i := 1 to N do    b[i] := a[i];  writeln('----------------------');  for i := 1 to N do    for j := i to N do      if a[j] < a[i] then      begin        buf := a[i];        a[i] := a[j];        a[j] := buf;      end; {  for i := 1 to N do    write('',a[i]:3); }  writeln('');  writeln('----------------------');  lCountEqualItems := 1;  buf := a[1];  for i := 2 to N do    if a[i] = buf then      Inc(lCountEqualItems)    else begin      if lCountEqualItems >= lSaveCountEqualItems then      begin        lSaveItem := buf;        lSaveCountEqualItems := lCountEqualItems;      end;      buf := a[i];      lCountEqualItems := 1;    end;    write('max Number in array = ',lSaveItem);    for i := 1 to N do    begin      if i mod 2 = 0 then      begin        buf := b[i];        b[i] := b[i - 1];        b[i - 1] := buf;      end;    end;  writeln('');  writeln('----------------------');  for i := 1 to N do    write('',b[i]:3);  readln; end.

Ой, Ren ты чего-то больно нагородил, помоему намного проще будет вот так
program ArrayFilter;
{$APPTYPE CONSOLE}
uses
SysUtils;

const
n = 10;
var
i, j, k: integer;
c, s, s1: integer;
buf:integer;
a: array [1..n] of integer;
procedure ArrayGenNOutput;
begin
write ('k: ');
readln (k);
randomize;
for i := 1 to n do
begin
a[i] := random (k);
write (a[i]:3,' | ');
end;
writeln;
end;
procedure TransArray;
begin
for i:=1 to N do
begin
if Odd(i) then
begin
buf:=a[i];
a[i]:=a[i+1];
end
else
a[i]:=buf;
end;
for i:=1 to N do
begin
write(' | ',a[i]:3);
read;
end;
end;
begin
ArrayGenNOutput;
TransArray;
writeln;
s := 0;
c := 0;
for j := 1 to n do
begin
s1 := 0;
for i := 1 to n do
if a[i]=a[j] then inc (s1);
if s1>=s then
begin
c := a[j];
s := s1;
end;
end;
writeln (c:5,':',s:5);
readln;
end.

яж просто редактировал код bivis и сказал:

Цитата

конечно не оптимально и не красиво, но работает (лень заморачивать)

а для сдачи лабараторной покатилобы наверно...

Премного благодарен!
Жизнь длинная, а Земля круглая может быть и сочтемси!