INFOMAN брой 21
{Входен файл: N M ; l1..ln ; L1..Lm
5 2
4
10
2
5
3
11
13
К О Р А Б И
Военното разузнаване на една държава съобщило, че всичките N<100 бойни
кораба на съседна вражеска държава са се събрали в едно пристанище и са се
разположили там в M<10 редици, като във всяка редица има поне по един кораб.
Известни са дължините на корабите l1..ln - цели числа от 1 до 100.
На разузнаването му се иска да знае в коя редица, кои кораби са разположени.
За съжаление разузнавателната подводница може да съобщи само сумите от дъл-
жините L1..Lm на корабите във всяка редица. Напишете програма, която намира
едно възможно разпределение на корабите по редици.
РЕШЕНИЕ
Тази задача почти може да се каже, че е стандартна и някои я определят като
задача за мултимерната раница. В общия случай в задачата се пита колко най-
много от N предмета, зададени с теглата си, могат да се съберат в M раници
с дадена положителна вместимост и по какъв начин. Задачата няма реализуемо
динамично решение, тъй като то изисква прекалено много памет и очевидният
метод е backtracking. В конкретният и облик, обаче, предварително знаем, че
всичките предмети се събират точно в раниците. И върху това, според мен, е
основният акцент. В решението на Петко Минков, публикувано в предния брой,
пълното изчерпване върви почти произволно по корабите и според мен е
възможно то да се оптимизира.
Идеята ми е почти същата - запълваме редиците от корабите една по една. Една
добра оптимизация, обаче е, че няма да се спускаме произволно по корабите,
а в зависимост от начините, по които те могат да образуват дадените суми.
За да образуваме подходяща структура използваме динамично оптимиране - зада-
чата дали можем да получим дадена сума чрез няколко предмета. Същественото
тук е, че на нас ни трябват самите разбивки, тъй като знаем, че сумите със
сигурност се получават. Структурата е следната:
Ach:Array[0..10000] Of PList
Ach[j] сочи към nil, ако сумата сумата j не може да се получи с дадените
кораби, а ако може да се получи Ach[j] е свързан списък от индексите i на
корабите, за които сумата Аch[j-boat[i]]<>nil и индекса i e по-голям от
всички индекси в списъка на Ach[j-boat[i]]. Последното условие е
с цел да не се получи повторение (например boat[5]+boat[1] и
boat[1]+boat[5]).
След като сме получили тази структура можем да се спускаме рекурсивно по
нея. Естествено един индекс не може да участва повече от един път в сумите
(декларираме си масив от boolean usedi, който определя дали даден кораб е
използван). При всяко спускане вървим по един начин за получаване на теку-
щата редица, като внимаваме да не използваме повторно някой кораб. В слу-
чай, че една редица е запълнена, продължаваме рекурсивно към следващата
и т.н. докато не запълним всички редици.
Добре е редиците да се запълват от по-малки към по-големи, тъй
като по-малките могат да се получат 'средно' по по-малко начини.
Реализацията е с процедурата Rec, която приема за аргумент k текущата сума,
която трябва да се получи. Броячът за редиците е глобална променлива и се
увеличава всеки път, когато запълним редица (k=0), а намаля, когато не
успеем да запълним дадена редица, тъй като корабите, които са останали не
позволяват това и с това се връщаме към следващият начин за получаване на
предходната редица. Условието за спиране е броячът да стане равен на m+1,
след което отпечатваме изхода. За да изведем редиците, както са постъпили
от входния файл използваме масив POrder: POrder[i] е индекса на редицата
в сортирания масив, която трябва да стои на място i в изхода.
Представеното решение тръгва за <1 sec на Pentium 166 MMX за тестовете на
журито.
Ivan Georgiev
}
Program Ivan;
Const InpFile='boat.pas';
Type Plist=^List;
List=Record
i:Integer;
Next:PList;
End;
Var MaxL,Curi,m,n:Integer;
L,WorkL,Order,POrder:Array[1..9] Of Integer;
Boat:Array[1..100] Of Integer;
UsedI:Array[1..100] Of boolean;
Ach:Array[0..10000] Of PList;
Ans:Array[1..10] Of Record
c:Integer;
m:Array[1..100] Of Integer;
End;
Procedure Add(Var p:PList;i:Integer);
Var Q:Plist;
Begin
New(Q);
Q^.i:=i;
Q^.Next:=P;
P:=Q;
End;
Procedure OutP;
Var i,j:Integer;
Begin
For i:=1 to m do
Begin
Writeln(Ans[Porder[i]].c);
For j:=1 to Ans[Porder[i]].C-1 Do
Write(Ans[Porder[i]].m[j],' ');
Writeln(Ans[Porder[i]].m[Ans[Porder[i]].c]);
End;
Halt(0);
End;
Procedure Dyn;
Var Sall,i,j,cup:Integer;
Begin
Add(Ach[0],0);
Sall:=0;
For i:=1 to n do
Begin
Inc(Sall,Boat[i]);
If Sall>MaxL Then Cup:=MaxL Else Cup:=Sall;
For j:=Cup Downto Boat[i] Do
If Ach[j-Boat[i]]<>nil Then
Add(Ach[j],i);
End;
End;
Procedure Rec(k:Integer);
Var i:Integer;
P:PList;
Begin
If k=0 Then
Begin
Inc(Curi);
If Curi=m+1 Then OutP;
Rec(L[curi]);
Dec(Curi);
End
Else
Begin
P:=Ach[k];
While P<>Nil Do
Begin
If (Not Usedi[P^.i]) Then
Begin
Usedi[P^.i]:=True;
Inc(Ans[curi].c);
Ans[curi].m[Ans[curi].c]:=Boat[P^.i];
Rec(k-Boat[P^.i]);
Dec(Ans[curi].c);
Usedi[P^.i]:=False;
End;
P:=P^.Next;
End;
End;
End;
Procedure Solve;
Var i:Integer;
Begin
Fillchar(usedi,sizeof(usedi),False);
Fillchar(ans,sizeof(ans),0);
Dyn;
Curi:=1;
Rec(L[1]);
End;
Procedure Init;
Var F:Text;
i,j,help:Integer;
Begin
Assign(f,InpFile);
Reset(f);
{четем от pas файла} Readln(f); {}
Readln(f,n,m);
For i:=1 to n do
Readln(f,Boat[i]);
maxl:=0;
For i:=1 to m do
Begin
Readln(f,L[i]);
If maxl<L[i] Then maxl:=l[i];
End;
Close(f);
For i:=1 to m Do Order[i]:=i;
For i:=1 to m do
For j:=1 to m-1 do
If l[j]>l[j+1] Then
Begin
Help:=l[j];l[j]:=l[j+1];l[j+1]:=Help;
Help:=order[j];order[j]:=order[j+1];order[j+1]:=Help;
End;
For i:=1 to m Do POrder[Order[i]]:=i;
For i:=0 to MaxL do Ach[i]:=Nil;
End;
Begin
Init;
Solve;
End.