pascal. массив. перестановка

[vykker]

Дан массив из N целых чисел. Сформировать массив M, в который поместить сначала все нулевые элементы исходного массива, затем- отрицательные элементы, затем положительные элементы.


в это программе нулевые-> положит->отрицат
помогите переделать
и если можно то зделать её проще?

program p2;
label 1;  {METKA}

TYPE mass= array [1..100] of real; {pishem, chto eto odnomernyy massiv}

{***nachalo oblasti s PROCEDURAMI***}
procedure copt (n:integer; Var x:mass);{procedura SORTIROVKI}
procedure obmen(var a,b:real); {procedura OBMENA}
var c:real;
begin
c:=a;  //??
a:=b;
b:=c;
end;
var i:integer;
swop:boolean; //??
begin
repeat
swop:=false;
for i:=1 to n-1 do
if x[i]>x[i+1] then begin
obmen(x[i],x[i+1]);
swop:=true;
end;
n:=n-1;
until not swop;
end;

Procedure vctavka (N,K:integer; Z:real; Var X:mass); {procedura VSTAVKI}
Var j:integer;
begin
For j:=N downto K do X[j+1]:=X[j];
X[K]:=Z;
End;

Procedure delet (N,K:integer; Var X:mass); {procedura UDALENIYa}
Var i:integer;
begin
For i:=k+1 to N do x[i-1]:=x[i];
end;

{***KONEC oblasti s PROCEDURAMI***}

var m:mass;  {ispol'zuemyy massiv}
    i,n:integer;
    wr:real;

begin
writeln ('razmer massiva:');
readln (n);
writeln ('N:');
for i:=1 to n do
read (m[i]);
writeln;
copt (n,m); {sortiruem massiv}
if m[1]=0 then goto 1 else begin {proveryaem est' li na pervom meste massiva otricatel'noe chislo}
repeat {*** esli est', to perestavlyaem eto chislo v konec massiva  }
wr:= m[1];
Delet (n,1,m); {udalyaem s pervogo mesta}
vctavka (n,n,wr,m); {vstavlyaem v konec}
until m[1]=0; {*** do teh por, poka na pervom meste ne okazhetsya "0" }
end;

1: writeln ('M:');
for i:=1 to n do write (m[i],' ');
readln ;

end.

Дан массив вещественных чисел. Указать позицию последнего экстремального элемента (т.е. минимального или максимального)

вот нахождение мах и мин
а как последнего экстримального не представляю

var
A:array [1..100] of integer;
max,min,n,i:integer;

begin
write('n=');
readln (n);

for i:=1 to n do
begin
read (a[i]);
write(a[i],' ');

end;

max:=a[1];
for i:=1 to n do
if a[i]>max
then max:=a[i];

writeln;
write ('max=', max);

min:=a[1];
for i:=1 to n do
if a[i]<min
then min:=a[i];

writeln;
write ('min=', min);
end.

[Grag]

А где в задании сказано, что нужно сортировать исходный массив?
Вставлять элементы в определенной последовательности (нулевые, отрицательные и положительные), не значит вставлять отсортированные...
Самое простое решение - задача выполняется за три прохода исходного массива...
Есть вариант, когда можно сделать за два прохода...

[vykker]

можно увидеть эту программу??

[Grag]

Чтобы увидеть программу - ее надо сначала написать.
Но просто так писать программы мне с некоторых пор уже не интересно...

С моим резюме и портфолио можно ознакомиться в соответствующих разделах на моем сайте:
http://igor-bachin.narod.ru

или по этим ссылкам:

http://www.autsorser.ru/index.php?action=rsm&user=59
http://www.autsorser.ru/index.php?action=prtfl&user=59

Контакты:
e-mail: delmas-61@mail.ru
icq: 585281783
Skype: delmas61

[ROMA2PVT]

Какие страшные действия происходят в первой проге.

uses
   crt;
var
  c,N,i:integer;
  mas1,mas2:array [1..20] of integer;
begin
clrscr;
randomize;
write('Введите количество элементов массива: ');
readln(N);
writeln('Исходный массив: ');
for i:=1 to N do
begin
mas1[i]:=random(10)-2;
write(mas1[i]:2,' ');
end;
c:=0;
for i:=1 to N do
if mas1[i]=0 then
begin
inc(c);
mas2[c]:=mas1[i]
end;
for i:=1 to N do
IF mas1[i] < 0 then
begin
inc(c);
mas2[c]:=mas1[i];
end;
for i:=1 to N do
if mas1[i]>0 then
begin
inc(c);
mas2[c]:=mas1[i]
end;
writeln;
writeln('Результирующий массив: ');
for i:=1 to N do
begin
write (mas2[i]:2,' ');
end;
readkey;
end.

[Grag]

Это за три прохода исходного массива.
А теперь сделай тоже самое, но за ДВА прохода исходного массива.
Поставлю положительный отзыв!

[vykker]

спасибо!))

[vykker]

а что нужно сделать со второй?

[ROMA2PVT]

Это за три прохода исходного массива.
А теперь сделай тоже самое, но за ДВА прохода исходного массива.
Поставлю положительный отзыв!

Я пишу не за отзывы а ради интереса.В этом вся фишка.

[Grag]

Скоро этот альтруизм закончится... И начнешь писать за деньги!
А теперь сделай тоже самое, но за ДВА прохода исходного массива, за интерес...