Здравствуйте, Надежда Лаптева.

Предлагаю решение второй задачи (см. приложение). Для наглядности на экран выводятся исходный массив и промежуточные результаты после каждого прохода.

Программа протестирована в Borland Pascal 7.0. Процедура сортировки может принимать массивы переменного размера, но в этой версии такие массивы не поддерживаются самим языком, если мне не изменяет память. Поэтому массив передается в процедуру посредством трюков с указателями и приведением типов. Проверка индексов должна быть отключена.

Из Википедии:
Сортировка перемешиванием (Шейкерная сортировка) (англ. Cocktail sort) — разновидность пузырьковой сортировки. Анализируя метод пузырьковой сортировки можно отметить два обстоятельства.

Анализируя метод пузырьковой сортировки можно отметить два обстоятельства.
Во-первых, если при движении по части массива перестановки не происходят, то эта часть массива уже отсортирована и, следовательно, ее можно исключить из рассмотрения.
Во-вторых, при движении от конца массива к началу минимальный элемент “всплывает” на первую позицию, а максимальный элемент сдвигается только на одну позицию вправо.

Эти две идеи приводят к следующим модификациям в методе пузырьковой сортировки. Границы рабочей части массива (т.е. части массива, где происходит движение) устанавливаются в месте последнего обмена на каждой итерации. Массив просматривается поочередно справа налево и слева направо.

Примеры реализации сортировки перемешиванием

Успехов!

Приложение:
program q177025;
{$R-} { отключаем проверку индексов }

type
t_intarray = array [0..0] of integer;
p_intarray = ^t_intarray;

{ вывод массива на экран }
procedure print_array( var a: t_intarray; n: integer; prefix: char );
var i: integer;
begin
write( prefix );
for i := 0 to n-1 do
write( a[i]:4 );
writeln;
end;

{ Шейкерная сортировка массива.
n - кол-во элементов в массиве
}
procedure cocktail_sort( var a: t_intarray; n: integer );
var k, l, r, tmp, i : integer;
begin
print_array( a, n, ':' ); { выводим на экран исходный массив - для наглядности }
l := 0; { левая граница }
r := n-1; { правая граница }
k := r; { индекс последнего изменения }
while r > l do begin
{ опускаем "тяжелые" элементы вниз
минимальный элемент на отрезке [l,r] опускается на свое место
}
for i := r downto l+1 do
if a[i] < a[i-1] then begin
tmp := a[i];
a[i] := a[i-1];
a[i-1] := tmp;
k := i;
end;

l := k; { все элементы до l упорядочены }
print_array( a, n, '<' );

{ поднимаем "легкие" элементы вверх
максимальный элемент на отрезке [l,r] поднимается на свое место
}
for i := l to r-1 do
if a[i] > a[i+1] then begin
tmp := a[i];
a[i] := a[i+1];
a[i+1] := tmp;
k := i;
end;
r := k; { все элементы после r упорядочены }
print_array( a, n, '>' );
end;
end;

const
a1: array [0..5] of integer = ( 12, 3, 5, 7, 9, 10 );
a2: array [0..5] of integer = ( 5, 7, 9, 10, 12, 3 );
var
p: p_intarray;

begin
p := p_intarray(@a1); { обходим проверку типов }
cocktail_sort( p^, 6 );

p := p_intarray(@a2);
cocktail_sort( p^, 6 );
end.

Здравствуйте, Надежда Лаптева.
Первая задача показалась ОЧЕНЬ интересной. По крайней мере, аналогов мне не попадалось.
(Подозреваю, что строка "4 3 5 7 9 - 1 2 2 2 1" должна была бы выглядеть так - "4 3 5 7 9 - 2 1 2 2 1").
Вариант решения в приложении.
Надеюсь более опытные эксперты поправят меня в местах, где я оказался неправ (особенно интересно было бы ознакомиться с "авторским" решением).

Приложение:
Uses
Crt;
Const
MinIndex = 1;
MaxIndex = 5;
Type
TNumSet = Set of Byte;
TOffset = Array[MinIndex..MaxIndex] of TNumSet;
TDataArray = Array[MinIndex..MaxIndex] of Integer;
Const
ResAr: TDataArray = (3, 4, 5, 7, 9);
ExAr: TDataArray = (2, 2, 2, 3, 1);
{Ряд наборов перестановок для тестирования (0, 0, 0, 0, 0) (4, 2, 0, 2, 4) (4, 0, 2, 1, 1) (3, 1, 2, 1, 3) (2, 2, 2, 3, 1)}
Var
Place: TOffset;
i, j: Byte;

function ItemsCount(s: TNumSet): Byte;
{Подсчет количества элементов в множестве}
var
result, i: Byte;
begin
result := 0;
for i := MinIndex to MaxIndex do
if (ResAr[i] in s) then
Inc(result);
ItemsCount := result;
end;

procedure PrintSets;
{Вывод множества на экран}
var
i, j: Byte;
begin
{Print values of places}
for i := MinIndex to MaxIndex do begin
Write(i:3, {'.', ItemsCount(Place[i]):3,} ': [');
for j := MinIndex to MaxIndex do begin
if (ResAr[j] in Place[i]) then
Write(ResAr[j]:2);
end;
Writeln(']');
end;
Writeln;
end;

procedure Solve;
{
Идея решения состоит в том, что большИе значения попадая в хвост уже из него не всплывают.
Значит начав просмотр с хвоста можно с большой вероятностью отыскать правильное первоначальное место элемента.
Меньшие значения могут совершать более "непредсказуемые" перемещения в процессе упорядочивания.
}
var
max, idx: Integer;
begin
for i := MaxIndex downto MinIndex do begin
if ExAr[i] = 0 then begin
{Если перестановок с этой позиции не было}
Place[i] := [ResAr[i]];
end else begin
for j := MaxIndex downto MinIndex do begin
if i = j then begin
if Not (Odd(ExAr[j])) then
{Если количество перемещений было четным, то, возможно, элемент перемещался, но вернулся на исходную позицию}
Place[j] := Place[j] + [ResAr[i]];
continue;
end;
if ((j < i) and (j + ExAr[j] = i)) or ((i < j) and (j - ExAr[j] = i)) then begin
{Если рассматриваемая позиция достижима из предполагаемой}
Place[j] := Place[j] + [ResAr[i]];
continue;
end;
end;
end;
end;

{Попытка приведения количества элементов в каждом множестве к единственному}
{WARNING! Не всякий набор перестановок дает единственный ответ.
К примеру для наборов (7, 3, 9, 5, 4) и (7, 5, 3, 9, 4) я насчитал одинаковый набор перестановок - (3, 1, 2, 1, 3)}
i := 0;
while (i <= MaxIndex) do begin
if (ItemsCount(Place[i]) > 1) then
for j := MinIndex to MaxIndex do
if (i = j) then
continue
else if ItemsCount(Place[j]) = 1 then
Place[i] := Place[i] - Place[j];
Inc(i);
end;

PrintSets;
end;

begin
ClrScr;
Solve;
readkey;
end.