Пожалуйста, помогите составить программу в паскале. В массиве X(N) каждый элемент равен...

Question

Пожалуйста, помогите составить программу в паскале. В массиве X(N) каждый элемент равен 0, 1 или 2. Переставить элементы массива так, чтобы сначала располагались все единицы, затем все двойки и, наконец, все нули (дополнительного массива не заводить).

Answer 1

Const
n=10;
var
a:array[1..n]of integer;
i,j,buf:integer;
begin
   for i:=1 to n do
      begin
         a[i]:=random(3);
         write(a[i]:4);
      end;
{сортирую по возрастанию}
 for i:=1 to n-1 do
    for j:=i+1 to n do
       if a[i]         begin
               buf:=a[i];
                a[i]:=a[j];
                a[j]:=buf;
         end;
{пересылаю нули в конец масива}
for i:=1 to n-1 do
    for j:=i+1 to n do
       if a[i]=0 then
         begin
               buf:=a[i];
                a[i]:=a[j];
                a[j]:=buf;
         end;
for i:=1 to n do
   write(a[i]:4);
end.

Comments

Спасибо за решение, но не совсем согласна. Когда используем функцию random - это случайные числа, промежуток указан от 0..до 3. Но в такой ситуации масив может быть заполнен нулями или двойками (или единицами и двойками), а в условии задачи сказано, что каждый элемент в массиве равен 0, 1 или 2. То есть в массиве хотя бы один элемент должен быть равен этому числу, то есть обязательно должны присутствовать и 0 и 1 и 2. При использовании функции random это не гарантируется.

---

Вот моё решение (взяла из книги):

---

Program novay20;

---

Program novay20;
Uses Crt;
Type om=array[1..256] of integer;
Var X:om;

---

i,N,s0,s1,s2:integer;
Procedure print_om(X:om;k:integer);
Var j:integer;
Begin
write ( ') ');
for j:=1 to k do
if j<>k then write (X[j], ', ');
else write (X[j]);
end;
Begin
Clrscr;
s0:=0; s1:=0; s2:=0;
write ('Сколько элементов в массиве: ');
Readln (N);
Writeln;
Writeln ('Введите элементы массива: ');
for i:=1 to N do

---

Begin
write (i, ') ');
Readln (X[i]);
case X[i] of
0:inc (s0);
1:inc (s1);
2:inc (s2);
else writeln; writeln ('Неверен ввод данных');
Readln;
Exit;
end;
end;
writeln;
for i:=1 to s1 do
X[i]:=1;
for i:=s1+1 to s1+s2 do
X[i]:=2;
for i:=s1+s2+1 to N do
X[i]:=0;
writeln;
writeln ('После перестановки элементов массив станет таким: ');
for i:=1 to N do
write (X[i]:2);
readln;
end.