Одномерные массивы.Помогите написать программу в Паскале

[VikkyVi]

Задача: Дан массив Х целых чисел. Вывести в порядке возрастания все числа стоящие на четных местах и встречающиеся более двух раз.

[Stilet]

Твои попытки увидеть возможно?

[VikkyVi]

program lab5;
var mass1:array[1..20] of integer;
mass2:array[1..10] of integer;
i,j,k,x,n:integer;
begin
for i:=1 to 20 do
begin
readln(x);
mass1[i]:=x;
end;
n:=0;
for i:=1 to 10 do
begin
x:=mass1[i*2];
k:=0;
for j:=1 to 20 do
if x=mass1[j] 
then k:=k+1;
end;
if k>2
then
begin
n:=n+1;
mass2[n]:=x;
end;
for i:=1 to n-1 do
for j:=1 to n-1 do
if mass2[i]>mass2[i+1]
then
begin
x:=mass2[i];
mass2[i]:=mass2[i+1];
mass2[i+1]:=x;
end;
writeln(mass2);
end.

[Stilet]

Жуть... Вырвиглазность 100%. кто тебя так учил писать программы?

program lab5;
var mass1:array[1..20] of integer;
     mass2:array[1..10] of integer;
i,j,k,x,n:integer;
begin

for i:=1 to 20 do readln(mass1[i]);
for i:=1 to 10 do mass2[i]:=mass1[i*2];

n=0;
for i:=1 to 10 do begin
 k=0; for j:=1 to 10 do if mass2[i]=mass2[j] then inc(k);
 if k>1 then inc(n);
 mass1[n]=mass2[i];
end;

for i:=1 to n-1 do
 for j:=1 to n-1 do
   if mass1[i]>mass1[j] then begin
     x:=mass1[i];
     mass1[i]:=mass1[j];
     mass1[j]:=x;
  end;

for i:=1 to n do write(mass1[i]:10);

readln;

end.

Так годится?

[VikkyVi]

Я первокурсница) для меня это в новизну все)в школе вообще подготовки не было, пытаюсь все сама понять, а это тяжело) но спасибо за коррекцию программы)

[Stilet]

Ну учись )
Если конечно это твоя специальность.
Иначе... Взятки взяточки )

[VikkyVi]

Знаете что я заметила? Программа-то работает, но она не выполняет условия вывода чисел встречающихся более двух раз. Что нужно добавить, что б она выводила такие числа?))

[Stilet]

Знаешь, если бы мне довелось решать твою задачу, я бы написал так:

program Project1;
const nn=10;
type arr=array[1..nn] of integer;
var x,y:arr;
  n:integer;

function Count(v:integer):Integer;var i,n:integer;
begin
  n:=0;
  for i:=1 to nn do if x[i]=v then inc(n);
  Count:=n;
end;

procedure newarr; var j,i:integer; ok:boolean;
begin
  n:=1;
  for i:=1 to nn do if (Count(x[i])>2) and odd(i) then begin
    ok:=true;
    for j:=1 to n do if y[j]=x[i] then begin ok:=false; break; end;
    if ok then begin    y[n]:=x[i];    inc(n); end;
	end;

end;

Procedure Sort; var v,i,j:integer;
begin
  for i:=1 to n do
   for j:=1 to n do
     if y[i]>y[j] then begin
       v:=y[i];
       y[i]:=y[j];
       y[j]:=v;
    end;
end;

procedure outme(a:arr;k:integer); var i:integer;
begin
  for i:=1 to k do write(a[i]:2); writeln;  writeln;
end;

procedure inme; var i:integer;
begin
  for i:=1 to nn do x[i]:=random(5);
end;

begin
 inme; outme(x,nn); newarr; outme(y,n); Sort; outme(y,n); readln;
end.

Ну или примерно так.