В одномерном массиве, состоящем из N вещественных элементов, преобразовать массив таким образом, чтобы сначала располагались все элементы, равные нулю, а потом - все остальные

code: #pascal
program p2;
label 1;  {METKA}
const MaxN=1000;               {maksimal'nyy razmer massiva (mozhno menyat')}
TYPE Vector= array [1..MaxN] of real; {pishem, chto eto odnomernyy massiv}
 
{***nachalo oblasti s PROCEDURAMI***}
procedure Sorting (n:integer; Var x:Vector);{procedura SORTIROVKI}
procedure exchange(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
exchange(x[i],x[i+1]); swop:=true; end;
n:=n-1;
until not swop;
end;
 
Procedure Insertion (N,K:integer; Z:real; Var X:Vector); {procedura VSTAVKI}
Var j:integer;
begin
For j:=N downto K do X[j+1]:=X[j];
X[K]:=Z;
End;
 
Procedure Deletion (N,K:integer; Var X:Vector); {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:Vector; {ispol'zuemyy massiv}
    i,n: integer;
    wr:real;
 
begin
writeln ('Vvedite N (razmernosti massiva):');
readln (n);
writeln ('Vvedite sam massiva(elementy ukazati cherez probel):');
for i:=1 to n do read (m[i]); writeln;
Sorting (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];
Deletion (n,1,m); {udalyaem s pervogo mesta}
Insertion (n,n,wr,m); {vstavlyaem v konec}
until m[1]=0; {*** do teh por, poka na pervom meste ne okazhetsya "0" }
end;
 
1: writeln ('REZULTAT:');
for i:=1 to n do write (m[i]:3:0,' ');
readln ;
 
end.      
Поделиться:

Похожие статьи: