I can confirm this is not homework.

To clear up things the question in as few words as possible is this:


"Given N real numbers, decide whether any subset sums to an integer."


**********************************

I posted the same question on Google Math.Symbolic and this is what they said:

Quote:

The empty set and the full set are also subsets. Presumably you
don't want them.


> In
>this case the answer is:
>

 >{ 0.12345,  0.6789,  0.19765 }  Total = 1.0 >or >{  0.31415,  0.68585  }         Total = 1.0 >

Multiplying by 10^d where d is the largest number of digits after
the decimal point, you can say equivalently: given N positive integers
whose sum is divisible by 10^d, decide whether any nonempty proper
subset has a sum divisible by 10^d.

I'm pretty sure this problem is NP-complete. If so, no polynomial-time
algorithm is known and it's unlikely that there is one.


Robert Israel isr...@math.ubc.ca
Department of Mathematics http://www.math.ubc.ca/~israel
University of British Columbia Vancouver, BC, Canada


*******************


This is, more or less, a subset sum problem. One way to attempt these
is via lattice reduction. (Closely related is to try to find small
integer relations and hope that some use all ones as multipliers). For
the case of what are called "low density" problems one will typically
meet with success.

Below is Mathematica code for a formulation due to Lagarias and
Odlyzko. A related method, with a better encoding (handles higher
density cases) is due to Schnorr and Euchner. One might want to fiddle
with the "expon" parameter, or with the criterion that selects rows
from the reduced lattice based on whether the first element is
sufficiently close to zero.


integerSubsetSum[v_] := Module[
{n=Length[v], v2=Rationalize[v], v3, expon=20,
lat, redlat, relations},
v3 = Flatten[{10^expon, Table[0,{n}]}];
lat = Transpose[Join[
{Round[10^expon*v2]}, IdentityMatrix[n]]];
lat = Join[lat,{v3}];
redlat = LatticeReduce[lat];
relations = Map[Drop[#,1]&,
Select[redlat, Abs[First[#]]<=10^(expon/5) &&
Max[Abs[Rest[#]]]==1 &]];
relations = Select[relations,
Apply[And,Thread[#<=0]] || Apply[And,Thread[#>=0]]&];
Map[v*#&, Abs[relations]] /. 0->Sequence[]
]


For your example:


vec = {0.12345, 0.6789, 0.19765, 0.31415, 0.68585};


In[82]:= integerSubsetSum[vec]
Out[82]= {{0.31415, 0.68585}, {0.12345, 0.6789, 0.19765}}


Daniel Lichtblau
Wolfram Research

I'm not sure I quite know what they're talking about but I think what they're saying is there's no quick way of doing it.

From my (limimted) understanding of this problem, here is my solution.

Create a new vector, in which new_vector = old_vector mod 1

You then use simulated anneling to find the answer.
The ''goodness' is how far away it is from 1.
if it goes over 1, you restart.

This should be okish.

From,
Nice coder

Hi all. Just wanted to say, that I eventually found the solution to this problem on the internet. The algorithm in question is called the LLL-algorithm and it finds approximate integer relations in polynomial time. I implemented it in my computer program for factorising polynomials and it does very well. For example it is good at factoring things like:

6*x+3*x^4+14+7*x^3+2*x^5+x^8 = (x^3+2)*(x^5+3*x+7)

Where the input is the roots of the polynomial multiplied by 1000 and the output is a matrix with 1's and 0's indicating which roots add up to integers.

I haven't quite solved the problem of factoring yet since with

x^8 + 1

although some pairs of roots add up to integers this doesn't necessarily lead to an integer factor so I'll have to add some supplementary conditions.

**************

Now most of all I need to find a way to recombine the roots in polynomial time. Because at the moment using the most naiive method, mutiplying this out:

(x-x0)*(x-x1)*(x-x2)*....(x-xn)

where x0,x1...xn are numbers takes at least 2^n sums even though the result has only n terms which is obviously not very efficient.