помогите с задачей

[kiko]

В одномерном массиве, состоящем из 20 (размерность массива задается именованной константой) вещественных элементов, вычислить:

1) вывести все элементы, встречающиеся в массиве более одного раза.
2) произведение и количество элементов массива, расположенных между максимальным и минимальным элементами.
3) заменить все отрицательные элементы средним арифметическим значением элементов массива.
4) упорядочить элементы массива по возрастанию.

Программа должна содержать меню, позволяющее пользователю выбрать нужное действие. Каждый логически законченный фрагмент должен быть оформлен в виде процедуры. Основная программа должна содержать вызовы процедур.

[Викдон]

4 задание:

Const n=10;
var Mas:array[1..n] of real;
c:real;
i,j:integer;
begin
for i:= 1 to n do
writeln(Mas[i]);


for i:=n downto 2 do {метод пузырька}
for j:=1 to i-1 do
if Mas[j]>Mas[j+1] then
begin
c:=Mas[j];
Mas[j]:=Mas[j+1];
Mas[j+1]:=c
end;

end.

[kiko]

спасибо

[kiko]

program A3;
uses crt;
var
a:array [1..20] of integer;
b:array [1..20] of integer;
s,s4:real;
i,k,i1,k1,v,na4,koH:integer;
begin
clrscr;
writeln ('BBEDUTE koJl-BO eJleMeHToB MaccuBa');
readln (n);
writeln;
writeln;
v:=0;
s:=0;
s4:=0;
for i:=1 to n do begin
a[i]:=random(50)-25; writeln (a[i]:3); end;
writeln;
for i:=1 to n do begin
if (i div 2)=0 then
s4:=s4+a[i];
end;
writeln ('CyMMA eJleMeHToB c 4eTHbIMu HoMepaMu', s4:8:4);
writeln;
writeln;
for i:=1 to n do
if a[i]<0 then begin
na4:=i;
break;
end;
for i:=n downto 1 do
if a[i]=0 then begin
koH:=i;
break;
end;
if i1<k1 then begin
for i1:=na4 to koH do
for k1:=koH to na4 do
k1:=na4;
i1:=koH;
s:=s+e[i];
v:=v+1;
end;
for k:=1 to n-1 do
for i:=1 to n-i do
if a[i]>a [i+1] then begin
l:=a[i];
a[i]:=a[i+1];
a[i+1]:=l;
end;
for i:=1 to n do writeln (a[i]:3);
writeln;
k:=0;
for i:=1 to n do
if a[i]>=0 then begin
k:=k+1;
b[k]:=a[i];
end;
for i:=1 to n do
if a[i]<0 then begin
k:=k+1;
b[k]:=a[i];
end;
writeln('^^^^^^^^^^^^^^^^^^^^^^^^') ;
for i:=1 to n do writeln (b[i]:3);
writeln;
writeln ('CyMMa eJleMeHToB',s:8:4);
writeln ('koJl-Bo eJleMeHToB',v:8:4);
end;
end.

[Викдон]

это вроде как не правильно(первое бросилось в глаза)
for k:=1 to n-1 do
for i:=1 to n-i do
if a[i]>a [i+1] then begin
l:=a[i];
a[i]:=a[i+1];
a[i+1]:=l;
end;

надо:
for i:=n downto 2 do {метод пузырька}
for j:=1 to i-1 do
if Mas[j]>Mas[j+1] then
begin
c:=Mas[j];
Mas[j]:=Mas[j+1];
Mas[j+1]:=c
end;

[Викдон]

for k:=1 to n-1 do
for i:=1 to n-i do
ты каждый раз будешь бегать до препоследнего элемента)) но это не влияет на работу))

[Fantoms01]

Парни нужна помощь а то у меня зачет а прогу не могу сделать!
Задание такое! Введите данные в массив о числа туристов. Если известны их Фамилия, Пол, Возраст, найти самого старшего и вывести его на экран, и вывести на экран всех туристов возраст которых больше среднего. Масив необходимо записать в Фаил. И сделать меню из пунктов
1) Добавление туристов в фаил
2) Нахождение самого старшего
3) Туристы возраст которых выше среднего

Вот мои наброски но почемуто прога не работает

program poxod;
type
tyrist=record
fam:string[20];
pol:string[10];
vozr:integer;
end;

var
pox: array[1..40] of tyrist;
c:tyrist;
b: char;



var fil: file of tyrist;
filename: string[12];
tur:tyrist;
a: char;
i,n,m: integer;



procedure newfile;
begin
write ('vvedite name fila:');
readln (filename);
assign (fil, filename);
rewrite (fil);
end;

procedure openfile;
begin
write ('vvedite name file:');
readln (filename);
assign (fil, filename);
reset (fil);

end;

procedure vvod;
var
b: char;
i,n,m,d:integer;
k:real;
begin
newfile;

writeln('skolko vsego tyristov');
readln(n);
writeln('vv dannue po kazhdomy tyristy');
for i:=1 to n do
with pox[i] do begin
write('vv familiu',i,'tyrista');
readln(fam);
write('vv pol',i,'tyrista');
readln(pol);
writeln('vv vozrast',i,'tyrista');
readln(vozr);
readln;
end;
write(fil,tur);
writeln('turistov v faile ',filesize(fil));
end;



procedure star;

begin
for i:=1 to n-1 do Begin
for m:=i to n do
if pox[i]. vozr>pox[m].vozr then begin
c:=pox[i];
pox[i]:=pox[m];
pox[m]:=c;
readln;
end;
end;
end;

procedure sred;
var d,c:integer;
k:real;
begin
writeln(pox[n].fam:20,pox[n].pol:10,pox[n].vozr:3);
d:=0;
for i:=1 to n do
d:=pox[i].vozr+d;
k:=d/n;
writeln('srednii vozrast',k:2:2);
for i:=1 to n do
if pox[i].vozr>k then writeln(pox[i].fam:20,pox[i].pol:10,pox[i].vozr:3);
readln;
end;

procedure menu2;

var d:char;
begin
writeln ('1.vvod famili');
writeln ('2.poisk samogo starhego');
writeln ('3.poisk srednego vozrasta');

writeln ('vvedite nomer trebuemogo deistvia, i najmite ENTER');
readln(a);
case a of
'1': begin
vvod;
close(fil);
menu2;
end;

'2': begin
openfile;
star;
menu2;
end;

'3': begin
openfile;
sred;
menu2;
end;

else writeln ('nekorrektny vvod! perezapustite programmu!');
end;
end;




begin

writeln ('1.rabota s bazoi');
writeln ('2.Vihod');

writeln ('vvedite nomer trebuemogo deistvia, i najmite ENTER');
readln(b);
case b of
'1': begin
menu2;
end;

else writeln ('nekorrektny vvod! perezapustite programmu!');
end;
end.

Помогите плиз а то экзамены скоро и эта хрень весит!

[Fantoms01]

народ но помагите кто может!

[alex_fcsm]

uses crt;
const n=20;
var a:array[1..n] of real;
    mult,min,max:real;
    i,l,r:integer;

begin
clrscr;
for i:=1 to n do
 begin
  a[i]:=random(10)+1;
  write(a[i]:5:1);
 end;
max:=a[1];min:=a[1];l:=1;r:=1;
 for i:=2 to n do
  if a[i]>max then begin
                    max:=a[i];
                    l:=i;
                   end
     else if a[i]<min then begin
                            min:=a[i];
                            r:=i;
                           end;
if l>r then begin
            i:=r;
            r:=l;
            l:=i;
            end;
writeln;
mult:=1;
for i:=l+1 to r-1 do
 mult:=mult*a[i];
writeln(r-l-1);
writeln(mult:4:1);
end.

[alex_fcsm]

uses crt;
const n=20;
var a:array[1..n] of real;
    mo:real;
    i:integer;

begin
clrscr;
for i:=1 to n do
 begin
  a[i]:=random(10)+1;
  write(a[i]:5:1);
 end;
mo:=0;
 for i:=1 to n do
  mo:=mo+a[i];
mo:=mo/n;
for i:=1 to n do
 if a[i]<0 then a[i]:=mo;
writeln;
for i:=1 to n do
write(a[i]:5:1);
end.