В одномерном массиве, состоящем из N вещественных элементов, преобразовать массив таким образом, чтобы сначала располагались все элементы, равные нулю, а потом — все остальные — 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.

Leave a Comment

90 − 80 =