Задан одномерный массив

[maxim1592]

Задан одномерный массив, в котором каждый элемент равен 0, 1 или 2. Не создавая дополнительного массива, переставить элементы исходного массива так, чтобы сначала располагались все 1, затем все 0 и, наконец все 2

[ZX Spectrum-128]

http://www.pascal.helpov.net/index/o...al_programming

[maxim1592]

а пример можно, а то там информации много, а собрать ее в программу сложновато...

[ZX Spectrum-128]

Заполнение массива под вашу задачу:

Var 
 A: array [1..10] of integer; 
 I : byte ; {переменная I вводится как индекс массива} 
Begin 
  For i :=1 to 10 do 
    A [ i ]:= random (2); { i -му элементу массива присваивается «случайное» целое число в диапазоне от 0 до 2}

[maxim1592]

а как сделать чтобы переставляла элементы по группам?

[ZX Spectrum-128]

{Задан одномерный массив, в котором каждый элемент равен 0, 1 или 2.
Не создавая дополнительного массива, переставить элементы исходного массива
так, чтобы сначала располагались все 1, затем все 0 и, наконец все 2}

const
    m = 10;
 
var
    arr: array[1..m] of integer;
    i, j, k: integer;
 
begin
    randomize;
 
    write ('Исходный массив: ');
    for i := 1 to m do begin
        arr[i] := random(3);
        write (arr[i]:4);
    end;
    writeln; writeln;


    for i := 1 to m-1 do
        for j := 1 to m-i do
            if arr[j] > arr[j+1] then begin
                k := arr[j];
                arr[j] := arr[j+1];
                arr[j+1] := k
            end;

    write ('Отсортированный массив: ');
    for i := 1 to m do
        write (arr[i]:4);

    writeln;

readln
end.

[Serge_Bliznykov]

коллега, не пойдёт.
Вы не обратили внимание, но там обычная сортировка не катит!

чтобы сначала располагались все 1, затем все 0 и, наконец все 2

я бы перехитрил сортировку так:

    for i := 1 to m-1 do
        for j := 1 to m-i do
            if (((arr[j]=0) or (arr[j]=2)) and (arr[j+1] = 1))
                  or ((arr[j]<>1) and (arr[j]>arr[j+1])) then begin
                k := arr[j];
                arr[j] := arr[j+1];
                arr[j+1] := k
            end;
...

хотя, подозреваю, что задача решается намного эффективнее, буквально за один проход по массиву.

например, так:

[maxim1592]

спасибо большое, тоже сразу не заметил

[Mad_Cat]

const nmax=10;
var 
  a:array[1..nmax] of byte;
  i,a1,a2,a0,n:byte;
begin
  Randomize;
  readln(n);
  a1:=0;a2:=0;a0:=0;
  for i:=1 to n do 
  begin
    a[i]:=random(3);
    if a[i]=0 then inc(a0)
    else if a[i]=1 then inc(a1)
      else inc(a2);
    write(a[i]:2);
  end;
  writeln;
  for i:=1 to n do 
  begin
    if i<=a1 then a[i]:=1
      else if i<=a1+a0 then a[i]:=0
        else a[i]:=2;
    write(a[i]:2);
  end;
end.

5
1 0 2 2 0
1 0 0 2 2

[ZX Spectrum-128]

Да, каюсь, не увидел. В голове отчего-то тумкнуло 0,1,2
Спасибо.