Алгоритм оптимального распределения камней по ящикам
01.01.2007
{ **** UBPFD *********** by kladovka.net.ru ****
>> Алгоритм оптимального распределения камней по ящикам
Зависимости: нет
Автор: Александр Шарахов, alsha@mailru.com, Москва
Copyright: Александр Шарахов
Дата: 4 марта 2003 г.
********************************************** }
{-------------------------------------------------------------------------------
Алгоритм оптимального распределения камней по ящикам
(с) Александр Шарахов (alsha@mailru.com) 2002
--------------------------------------------------------------------------------
Разрешается использовать в некоммерческих продуктах и свободно распространять
при условии сохранения исходного текста.
--------------------------------------------------------------------------------
Литература.
Прототипом алгоритма послужила "Задача о куче камней", которую рассматривал
И.В. Романовский в своей книге "Алгоритмы решения экстремальных задач", "Наука",
М., 1977, с.248.
Алгоритм существенно переработан и дополнен, исправлены найденные ошибки.
--------------------------------------------------------------------------------
Постановка задачи. Входные данные.
Имеется StoneCount камней и BoxCount ящиков. Веса камней (целые положительные
числа) заданы в массиве StonesArray[0..StoneCount-1]. Требуется распределить
камни по ящикам так, чтобы вес самого тяжелого ящика был минимальным.
Очевидно, частным случаем является задача обеспечения равенства веса всех ящиков.
Возможны 2 варианта распределения:
1. Экономный вариант (FillAllBoxes=false). Ясно, что среди камней может
встретиться настолько тяжелый камень, что вес самого тяжелого ящика будет равен
весу этого камня, и для размещения всех камней может оказаться достаточно
меньшего количества ящиков. Использование всех ящиков никак не изменит вес самого
тяжелого ящика. Поэтому в экономном варианте разрешается использовать не все
имеющиеся ящики.
2. Расточительный вариант (FillAllBoxes=true). Здесь требуется обязательно
использовать все имеющиеся ящики. При этом вес ящиков, в которых находится ровно
один камень, не учитывается. Для остальных ящиков решается задача минимизации
веса самого тяжелого ящика.
Кроме того, для каждого из указанных вариантов, задав Equalize=true, можно
заказать выравнивание веса ящиков, т.е. потребовать, чтобы вес самого легкого
ящика был максимальным.
--------------------------------------------------------------------------------
Комментарии к решению. Выходные данные.
Если массив StonesArray[0..StoneCount-1] не отсортирован, то в начале работы
процедура выполняет сортировку его элементов по убыванию. Встроенная сортировка
неэффективна при больших StoneCount, поэтому целесообразно сортировать данные
до вызова процедуры более эффективным алгоритмом.
Для решения задачи применяется метод ветвей и границ. Промежуточные данные
в процессе вычислений хранятся в оперативной памяти. Потребности в памяти
составляют SizeOf(integer) * (Max(Stones[i]) + 3 * StoneCount + BoxCount).
Результат работы процедуры (размещение камней по ящикам) помещается в массив
BoxesArray[0..StoneCount-1], размер которого должен быть установлен до ее вызова.
Элементами этого массива являются индексы камней, увеличенные на 1. Индексы
первых камней в ящиках помечены знаком минус.
Дополнительная информация о решении помещается в переменные:
NeedBoxes - количество использованных ящиков, BigBoxes - количество ящиков,
в которых находится ровно один "большой" камень (FillAllBoxes=true),
BoxSize - размер ящиков, MaxWeight - максимальный вес ящика (может быть больше
BoxSize, если FillAllBoxes=true), MinWeight - минимальный вес ящика.
При работе процедуры возможно появление ошибочных ситуаций. Возвращаемые коды
ошибок: -1 - неверные входные данные, -2 - недостаточно оперативной памяти.
Работа алгоритма проверена на Delphi6 + Windows98.
-------------------------------------------------------------------------------}
unit OptBox; // Sha 2002
interface
procedure OptimizeBoxes(var StonesArray, BoxesArray: array of integer;
StoneCount, BoxCount: integer;
FillAllBoxes, Equalize: boolean;
var NeedBoxes, BigBoxes, BoxSize, MaxWeight, MinWeight: integer);
implementation
procedure OptimizeBoxes(var StonesArray, BoxesArray: array of integer;
StoneCount, BoxCount: integer;
FillAllBoxes, Equalize: boolean;
var NeedBoxes, BigBoxes, BoxSize, MaxWeight, MinWeight: integer);
var
Boxes: array[1..$3FFFFFFF] of integer absolute BoxesArray;
Stones: array[1..$3FFFFFFF] of integer absolute StonesArray;
Place: array of integer; //[0..Stones[1]] В Place[w] - индекс тяжелейшего среди всех с весом не более w
Left, Right: array of integer; //[0..StoneCount+1] Левые и правые соседи для каждого камня
Used: array of integer; //[1..StoneCount] Использованные камни, первый в ящике - отрицательный
Space: array of integer; //[1..BoxCount] В Space[i] - свободное место в i-том ящике
StoneNo, UsedNo, SpaceNo: integer; //Индексы в соответствующих масивах
Zero: integer; //Камни с номерами 1..Zero лежат каждый в своем большом ящике
SumTotal: integer; //Общий вес всех камней
SumMin, SumMax, SumTest: integer; //Оценки веса самого тяжелого ящика
SpaceMin, SpaceMax, SpaceTest: integer;//Оценки недовеска самого легкого ящика
RestSpace, CurSpace: integer; //Остатки места: общий и в текущем ящике
ErrorCode: integer; //0=OK, -1=ошибка в параметрах, -2=недостаточно памяти
i, j, Weight: integer; //Временные
NewBox, EraseBox, BoxOK: boolean; //Создать ящик, убить ящик, ящик заполнен удовлетворительно
Sorted: boolean; //Камни отсортированы (тяжелые раньше)
label
BoxingFailed, EqulizingFailed;
begin;
//Проверим отсортированность массива
Sorted:=true;
for i:=1 to StoneCount-1 do if Stones[i]<Stones[i+1] then begin;
Sorted:=false; break;
end;
//Если массив не отсортирован, сортируем камни по убыванию веса (тяжелые раньше)
if not Sorted then for i:=1 to StoneCount-1 do begin;
Weight:=Stones[i];
for j:=i+1 to StoneCount do if Weight<Stones[j] then begin;
Stones[i]:=Stones[j]; Stones[j]:=Weight; Weight:=Stones[i];
end;
end;
//Не надо мучить мою программу плохими данными
ErrorCode:=0;
if (StoneCount<=0) or (BoxCount<=0)
or (length(StonesArray)<StoneCount) or (length(BoxesArray)<StoneCount)
or (Stones[1]>=512*1024*1024) or (Stones[StoneCount]<=0)
then ErrorCode:=-1;
//Выделение памяти
if ErrorCode=0 then try
SetLength(Place, Stones[1] + 1);
SetLength(Left, StoneCount + 2);
SetLength(Right, StoneCount + 2);
SetLength(Used, StoneCount + 1); //Нулевой элемент не используется
SetLength(Space, BoxCount + 1); //Нулевой элемент не используется
except ErrorCode:=-2; end;
if ErrorCode<>0 then begin;
NeedBoxes:=ErrorCode; BigBoxes:=0; BoxSize:=0; MaxWeight:=0; MinWeight:=0;
end
else begin; //Если ErrorCode=0 будем решать задачу
SumTotal:=0; Weight:=Stones[1];
for i:=1 to StoneCount do begin;
SumTotal:=SumTotal+Stones[i]; //Подсчет суммарного веса
for j:=Stones[i] to Weight do Place[j]:=i; //Заполняем Place[]
Weight:=Stones[i]-1;
end;
for j:=0 to Weight do Place[j]:=StoneCount+1; //Нет камней с таким весом
//Решение, которое всегда есть
NeedBoxes:=1; BigBoxes:=0; BoxSize:=SumTotal;
Boxes[1]:=-1; for i:=2 to StoneCount do Boxes[i]:=i;
//Начальные значения оценок размера ящика:
//- для верхней решение точно существует,
//- ниже нижней решения точно нет.
SumMax:=SumTotal; //Оценка решения сверху
if FillAllBoxes then SumMin:=Stones[StoneCount] //Oценка решения снизу
else begin;
SumMin:=(SumTotal+BoxCount-1) div BoxCount; //Если в каждом ящике поровну
if SumMin<Stones[1] then SumMin:=Stones[1]; //Если есть большие камни
end;
//Мы будем проверять, подходит ли нам яшик размером (верхняя + нижняя граница)/2,
//затем в соответствии с результатом проверки сдвинем одну из границ:
//нижнюю - вверх, верхнюю - вниз.
//Когда границы совпадут, мы получим минимальный размер ящика.
repeat;
SumTest:=(SumMin+SumMax) shr 1; //Округляем среднее вниз
//Подсчет перегруженных и полностью загруженных ящиков
//Т.к. в таких ящиках помещается (а может быть даже выступает при этом :)
//ровно один камень, то эти ящики можно исключить при поиске решения
Weight:=0; Zero:=0;
while (Zero<StoneCount) and (Stones[Zero+1]>=SumTest) do begin;
Weight:=Weight+Stones[Zero+1]; inc(Zero);
end;
//Остаток свободного пространства во всех коробках
RestSpace:=SumTest*(BoxCount-Zero)-(SumTotal-Weight);
if RestSpace<0 then begin;
SumMin:=SumTest+1; //Решения нет
goto BoxingFailed;
end;
UsedNo:=Zero; //Не использован ни один камень после Zero
SpaceNo:=Zero; //Не заполнили ни одного ящика после Zero
//Начальное заполнение массивов индексов соседей
for i:=Zero to StoneCount do begin;
Right[i]:=i+1; //Индекс правого соседа Right[Zero..StoneCount] (для всех камней)
Left[i+1]:=i; //Индекс левого соседа Left[Zero+1..StoneCount+1] (для неиспользованных)
end;
Right[StoneCount+1]:=StoneCount+1; //Соседи граничных - они сами
Left[Zero]:=Zero;
if Zero<StoneCount then repeat; //Раскладываем камни правее Zero
//Новый ящик
BoxOK:=true; //Старый ящик перезаполнять не надо
NewBox:=true; //Начнем формировать новый ящик
inc(SpaceNo); //Номер нового ящика
CurSpace:=SumTest; //Ящик пуст, т.е. свободен полностью
StoneNo:=Zero; //Будем брать соседа Zero справа, т.е. самый тяжелый из оставшихся
repeat; //Продолжим заполнение ящика
//Отменяем предыдущие назначения
if not BoxOK then repeat; //Плохой ящик - подправим
StoneNo:=Used[UsedNo]; EraseBox:=false; //Вернем этот камень
if StoneNo<0 then begin; //Если камень был первым в ящике
StoneNo:=-StoneNo; EraseBox:=true; //Флаг, что ящик надо убить
end;
dec(UsedNo); //Удаляем камень из списка использованных
Left[Right[StoneNo]]:=StoneNo; //Возвращаем его в левый и правый списки
for i:=Left[StoneNo] to StoneNo-1 do Right[i]:=StoneNo;
CurSpace:=CurSpace+Stones[StoneNo]; //Освобождаем занятое им пространство
if EraseBox then begin; //Убьем ящик
dec(SpaceNo); //Стало на ящик меньше
if SpaceNo<=Zero then begin; //Если это был последний ящик
SumMin:=SumTest+1; //Решения нет
goto BoxingFailed;
end;
CurSpace:=Space[SpaceNo]; //Свободное пространство в предыдущем ящике
end;
until not EraseBox; //Последним отменяем непервый камень в ящике
//Делаем новые назначения
while (UsedNo<StoneCount) //Пока есть камни
and (CurSpace>=Stones[Left[StoneCount+1]]) do begin; //и есть место для самого мелкого
if BoxOK then begin; //Если ящик хороший (не после отмены) решаем что брать дальше
//Если новый ящик или места хватит любому будем брать соседа Zero
if NewBox or (CurSpace>=Stones[1]) then StoneNo:=Zero
//Если есть слишком тяжелые - первого подхоящего
else if StoneNo<Place[CurSpace]-1 then StoneNo:=Place[CurSpace]-1;
end; //Иначе соседа текущего
BoxOK:=true; //Теперь ящик хороший - забыть про отмены
StoneNo:=Right[StoneNo]; //Берем (делаем текущим) новый камень
if StoneNo=StoneCount+1 then break; //Если нет больше подходящих камней
inc(UsedNo); Used[UsedNo]:=StoneNo; //Фиксируем взятие
if NewBox then begin;
NewBox:=false; Used[UsedNo]:=-StoneNo;
end;
CurSpace:=CurSpace-Stones[StoneNo]; //Вычисляем недовесок в текущем ящике
Left[Right[StoneNo]]:=Left[StoneNo]; //Левый сосед правого соседа взят
//Новый правый сосед у всех левее текущего
for i:=Left[StoneNo] to StoneNo-1 do Right[i]:=Right[StoneNo];
end;
//Требуется отмена, если текущий недовесок превысил остаток свободного пространства
BoxOK:=(CurSpace<=RestSpace)
until BoxOK; //Вываливаемся, если заполнили нормально
Space[SpaceNo]:=CurSpace; //Сохраним недовесок текущего ящика
RestSpace:=RestSpace-CurSpace; //Подсчет остатка свободного пространства
until UsedNo=StoneCount; //Пока не кончатся все камни
//Если мы здесь, значит решение найдено для ящиков размером SumTest
//Определяем минимальное свободное пространство по всем ящикам
if Zero<SpaceNo then begin;
CurSpace:=Space[Zero+1];
for i:=Zero+2 to SpaceNo do if CurSpace>Space[i] then CurSpace:=Space[i];
end
else CurSpace:=0;
//Вычисляем максимальный вес ящика (правее Zero) для найденного решения
SumMax:=SumTest-CurSpace;
//Сохраняем найденное решение
NeedBoxes:=SpaceNo; BigBoxes:=Zero; BoxSize:=SumMax;
for i:=1 to Zero do Boxes[i]:=-i; //Первые Zero ящиков
for i:=Zero+1 to StoneCount do Boxes[i]:=Used[i]; //Остальные
BoxingFailed:
until SumMin>=SumMax;
if Equalize and (BigBoxes+1<NeedBoxes) then begin;
//Вернемся к ранее найденному решению
Zero:=BigBoxes;
//Суммарный вес камней Zero+1..StoneCount
Weight:=0; for i:=1 to Zero do Weight:=Weight+Stones[i];
Weight:=SumTotal-Weight;
//Начальные значения оценок максимального пространства в ящике:
//- для верхней решение точно существует,
//- ниже нижней решения точно нет.
SpaceMin:=BoxSize - Weight div (NeedBoxes-Zero); //Оценка решения снизу
SpaceMax:=SpaceMin; //Oценка решения сверху
Weight:=BoxSize;
for i:=StoneCount downto Zero+1 do begin;
j:=Boxes[i];
if j>=0 then Weight:=Weight-Stones[j]
else begin;
Weight:=Weight-Stones[-j];
if SpaceMax<Weight then SpaceMax:=Weight;
Weight:=BoxSize;
end;
end;
//Мы будем проверять, можно ли распределить камни по ящикам так, чтобы
//в самом легком из них осталось места не больше (верхняя + нижняя граница)/2,
//затем в соответствии с результатом проверки сдвинем одну из границ:
//нижнюю - вверх, верхнюю - вниз.
//Когда границы совпадут, мы получим максимальный вес самого легкого ящика.
while SpaceMin<SpaceMax do begin;
SpaceTest:=(SpaceMin+SpaceMax) shr 1; //Округляем среднее вниз
UsedNo:=Zero; //Не использован ни один камень после Zero
SpaceNo:=Zero; //Не заполнили ни одного ящика после Zero
//Начальное заполнение массивов индексов соседей
for i:=Zero to StoneCount do begin;
Right[i]:=i+1; //Индекс правого соседа Right[Zero..StoneCount] (для всех камней)
Left[i+1]:=i; //Индекс левого соседа Left[Zero+1..StoneCount+1] (для неиспользованных)
end;
Right[StoneCount+1]:=StoneCount+1; //Соседи граничных - они сами
Left[Zero]:=Zero;
repeat; //Раскладываем камни правее Zero
//Новый ящик
BoxOK:=true; //Старый ящик перезаполнять не надо
NewBox:=true; //Начнем формировать новый ящик
inc(SpaceNo); //Номер нового ящика
CurSpace:=BoxSize; //Ящик пуст, т.е. свободен полностью
StoneNo:=Zero; //Будем брать соседа Zero справа, т.е. самый тяжелый из оставшихся
repeat; //Продолжим заполнение ящика
//Отменяем предыдущие назначения
if not BoxOK then repeat; //Плохой ящик - подправим
StoneNo:=Used[UsedNo]; EraseBox:=false; //Вернем этот камень
if StoneNo<0 then begin; //Если камень был первым в ящике
StoneNo:=-StoneNo; EraseBox:=true; //Флаг, что ящик надо убить
end;
dec(UsedNo); //Удаляем камень из списка использованных
Left[Right[StoneNo]]:=StoneNo; //Возвращаем его в левый и правый списки
for i:=Left[StoneNo] to StoneNo-1 do Right[i]:=StoneNo;
CurSpace:=CurSpace+Stones[StoneNo]; //Освобождаем занятое им пространство
if EraseBox then begin; //Убьем ящик
dec(SpaceNo); //Стало на ящик меньше
if SpaceNo<=Zero then begin; //Если это был последний ящик
SpaceMin:=SpaceMin+1; //Решения нет
goto EqulizingFailed;
end;
CurSpace:=Space[SpaceNo]; //Свободное пространство в предыдущем ящике
end;
until not EraseBox; //Последним отменяем непервый камень в ящике
//Делаем новые назначения
while (UsedNo<StoneCount) //Пока есть камни
and (CurSpace>=Stones[Left[StoneCount+1]]) do begin; //и есть место для самого мелкого
if BoxOK then begin; //Если ящик хороший (не после отмены) решаем что брать дальше
//Если новый ящик или места хватит любому будем брать соседа Zero
if NewBox or (CurSpace>=Stones[1]) then StoneNo:=Zero
//Если есть слишком тяжелые - первого подхоящего
else if StoneNo<Place[CurSpace]-1 then StoneNo:=Place[CurSpace]-1;
end; //Иначе соседа текущего
BoxOK:=true; //Теперь ящик хороший - забыть про отмены
StoneNo:=Right[StoneNo]; //Берем (делаем текущим) новый камень
if StoneNo=StoneCount+1 then break; //Если нет больше подходящих камней
inc(UsedNo); Used[UsedNo]:=StoneNo; //Фиксируем взятие
if NewBox then begin;
NewBox:=false; Used[UsedNo]:=-StoneNo;
end;
CurSpace:=CurSpace-Stones[StoneNo]; //Вычисляем недовесок в текущем ящике
Left[Right[StoneNo]]:=Left[StoneNo]; //Левый сосед правого соседа взят
//Новый правый сосед у всех левее текущего
for i:=Left[StoneNo] to StoneNo-1 do Right[i]:=Right[StoneNo];
end;
//Требуется отмена, если текущий недовесок превысил лимит
BoxOK:=(CurSpace<=SpaceTest)
and ((SpaceNo<NeedBoxes) and (UsedNo<>StoneCount)
or (SpaceNo=NeedBoxes) and (UsedNo=StoneCount));
until BoxOK; //Вываливаемся, если заполнили нормально
Space[SpaceNo]:=CurSpace; //Сохраним недовесок текущего ящика
until UsedNo=StoneCount; //Пока не кончатся все камни
//Если мы здесь, значит решение найдено для недовесков размером SpaceTest
//Определяем максимальное свободное пространство по всем ящикам (правее Zero)
SpaceMax:=Space[Zero+1];
for i:=Zero+2 to SpaceNo do if SpaceMax<Space[i] then SpaceMax:=Space[i];
//Сохраняем только изменения основного решения
for i:=Zero+1 to StoneCount do Boxes[i]:=Used[i];
EqulizingFailed:
end; //для while SpaceMin<SpaceMax
end; //для Equalize
//Находим MaxWeight, MinWeight и правим BigBoxes для нашего решения
MaxWeight:=-1; MinWeight:=-1;
Weight:=0;
for i:=StoneCount downto 1 do begin;
j:=Boxes[i];
if j>=0 then Weight:=Weight+Stones[j]
else begin;
Weight:=Weight+Stones[-j];
if MaxWeight<Weight then MaxWeight:=Weight;
if (MinWeight>Weight) or (MinWeight<0) then MinWeight:=Weight;
if (i<=BigBoxes) and (Weight<=BoxSize) then dec(BigBoxes);
Weight:=0;
end;
end;
end; //для ErrorCode=0
//Вернем память
Place:=nil;
Left:=nil;
Right:=nil;
Used:=nil;
Space:=nil;
end;
end.
Пример использования:
unit BagU;
interface
uses
OptBox, SysUtils, Classes, Controls, Forms, StdCtrls;
type
TForm1 = class(TForm)
bCalculate: TButton;
edBoxCount: TEdit;
cbFillAllBoxes: TCheckBox;
cbEqualize: TCheckBox;
mStones: TMemo;
mBoxes: TMemo;
lBoxCount: TLabel;
lStones: TLabel;
lBoxes: TLabel;
procedure bCalculateClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.bCalculateClick(Sender: TObject);
var
Boxes: array of integer;
Stones: array of integer;
BoxCount, StoneCount: integer;
FillAllBoxes, Equalize: boolean;
BoxSize, NeedBoxes, BigBoxes, MaxWeight, MinWeight: integer;
i, j, k: integer;
s: string;
begin;
mBoxes.Lines.Clear;
try
FillAllBoxes:=cbFillAllBoxes.Checked;
Equalize:=cbEqualize.Checked;
BoxCount:=StrToInt(Trim(edBoxCount.Text));
StoneCount:=mStones.Lines.Count;
SetLength(Boxes,StoneCount);
SetLength(Stones,StoneCount);
for i:=0 to StoneCount-1 do Stones[i]:=StrToInt(Trim(mStones.Lines[i]));
OptimizeBoxes(Stones, Boxes, StoneCount, BoxCount, FillAllBoxes, Equalize,
NeedBoxes, BigBoxes, BoxSize, MaxWeight, MinWeight);
if NeedBoxes>0 then begin;
mBoxes.Lines.Add(Format('Надо ящиков: %d',[NeedBoxes]));
mBoxes.Lines.Add(Format('В т.ч. больших: %d',[BigBoxes]));
mBoxes.Lines.Add(Format('Размер ящиков: %d',[BoxSize]));
mBoxes.Lines.Add(Format('Макс. загрузка: %d',[MaxWeight]));
mBoxes.Lines.Add(Format('Мин. загрузка: %d',[MinWeight]));
k:=0;
for i:=0 to StoneCount-1 do begin;
j:=Boxes[i];
if j<0 then begin;
j:=-j; inc(k); if k<=BigBoxes then s:='o' else s:='';
mBoxes.Lines.Add(Format('------------%s %d',[s,k]));
end;
mBoxes.Lines.Add(IntToStr(Stones[j-1]));
end;
end;
except end;
Boxes:=nil;
Stones:=nil;
end;
end.