Re: 0/1 knapsack-like minimalization problem and file
- To: mathgroup at smc.vnet.net
- Subject: [mg108772] Re: 0/1 knapsack-like minimalization problem and file
- From: Peter Sisak <p-kun80 at hotmail.com>
- Date: Wed, 31 Mar 2010 05:25:54 -0500 (EST)
Hello,
I tested the routine you put in, and while the speed was much more respectable than the first example, it is faulty somehow, tested on my data sets. See the following example:
In[13]:== vals == {1305892864, 1385113088, 856397968, 1106152425,
1647145093, 1309917696, 1096825032, 1179242496, 1347631104,
696451130, 746787826, 1080588288, 1165223499, 1181095818, 749898444,
1147613713, 1280205208, 1242816512, 1189588992, 1232630196,
1291995024, 911702020, 1678225920, 1252273456, 934001123, 863237392,
1358666176, 1714134790, 1131848814, 1399329280, 1006665732,
1198348288, 1090000441, 716904448, 677744640, 1067359748,
1646347388, 1266026326, 1401106432, 1310275584, 1093615634,
1371899904, 736188416, 1421438976, 1385125391, 1324463502,
1489042122, 1178813212, 1239236096, 1258202316, 1364644352,
557194146, 555102962, 1383525888, 710164700, 997808128, 1447622656,
1202085740, 694063104, 1753882504, 1408100352}
Out[13]== {1305892864, 1385113088, 856397968, 1106152425, 1647145093, \
1309917696, 1096825032, 1179242496, 1347631104, 696451130, 746787826, \
1080588288, 1165223499, 1181095818, 749898444, 1147613713, \
1280205208, 1242816512, 1189588992, 1232630196, 1291995024, \
911702020, 1678225920, 1252273456, 934001123, 863237392, 1358666176, \
1714134790, 1131848814, 1399329280, 1006665732, 1198348288, \
1090000441, 716904448, 677744640, 1067359748, 1646347388, 1266026326, \
1401106432, 1310275584, 1093615634, 1371899904, 736188416, \
1421438976, 1385125391, 1324463502, 1489042122, 1178813212, \
1239236096, 1258202316, 1364644352, 557194146, 555102962, 1383525888, \
710164700, 997808128, 1447622656, 1202085740, 694063104, 1753882504, \
1408100352}
In[14]:== closestSum2[vals_, target_] :==
Module[{x, vars, len == Length[vals], obj, constraints, max, best},
vars == Array[x, len];
obj == vars.vals;
constraints ==
Join[Map[0 <== # <== 1 &, vars], {obj <== target,
Element[vars, Integers]}];
{max, best} == FindMaximum[{obj, constraints}, vars];
{max, vars /. best}]
In[23]:== Select[(vals (closestSum2[vals, 8547993600])[[2]]), #> 0 &]
Out[23]== {1305892864, 696451130, 749898444, 1189588992, 1399329280, \
1178813212}
The output is far from being optimal, or even close to the target value. The hand-picked list {1753882504, 1714134790, 1678225920, 1647145093, 1198348288, 555102962} for example sums to 8546839557, which is much closer to the target value than the produced output, with a sum of only 6519973922. Did a typo slip in somehow, or some artifice needs to be employed to convince Mathematica to actually do the job?
Waiting for your reply
Peter Sisak
----------------------------------------
> Date: Tue, 30 Mar 2010 11:42:34 -0500
> From: danl at wolfram.com
> To: p-kun80 at hotmail.com
> CC: mathgroup at smc.vnet.net
> Subject: Re: [mg108755] 0/1 knapsack-like minimalization problem and file system access
>
> Peter Sisak wrote:
>> Given the files in a directory, by what method can I receive the list of
>> the files that in size is closest to, but not larger than, an arbitrary
>> x value, given in bytes? Each file can be listed at most once. The file
>> names and their respective sizes must be read in by Mathematica. (The directory contains files with count of around two-three hundred, thus making a brute force "sum then compare" search of all possible combinations would most probably not finish before the next ice age coming...)
>> An extension to the above problem: how to find the lists of files, if there are more than one lists permitted, and the aim is to minimise the total difference between the respective groups and the (identical) x value? (Think archiving data using the least amount of identical-type CDs, or wasting the least amount, and leaving the few odd ones out.)
>>
>> Any ideas how to pull this? Thanks in advance
>> Peter Sisak
>>
>
> I keep forgetting that FindMinimum has very effective ILP capabilities,
> at least for the case of 0-1 programming. The variant below is
> significantly faster than the one I first sent in response.
>
> closestSum2[vals_, target_] :== Module[
> {x, vars, len==Length[vals], obj, constraints, max, best},
> vars == Array[x,len];
> obj == vars.vals;
> constraints == Join[Map[0<==#<==1&, vars],
> {obj<==target, Element[vars,Integers]}];
> {max, best} == FindMaximum[{obj, constraints}, vars];
> {max, vars/.best}
> ]
>
> Here is an example with 300 random values in the range 0-10^4, where our
> target to approach but not exceed is 10^6.
>
> vals == RandomInteger[10000, 300];
>
> In[23]:== InputForm[Timing[closestSum[vals, 1000000]]]
>
> Out[23]//InputForm==
> {12.624081, {1.*^6, {0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0,
> 1, 0,
> 1, 0, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1,
> 1, 1,
> 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1,
> 1, 0,
> 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1,
> 0, 0,
> 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1,
> 0, 1,
> 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 1,
> 1, 0,
> 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1,
> 0, 0,
> 0, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1,
> 0, 0,
> 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
> 1, 1,
> 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
> 1, 1,
> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
> 1, 1,
> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
> 1, 0,
> 1, 0, 1, 1, 1, 0}}}
>
> Daniel Lichtblau
> Wolfram Research
_________________________________________________________________