2
$\begingroup$

I know there's a way to find partitions of an integer as a sum like:

IntegerPartitions[12,All,{1,4,7}]

which returns

{{7, 4, 1}, {7, 1, 1, 1, 1, 1}, {4, 4, 4}, {4, 4, 1, 1, 1, 1}, {4, 1, 1, 1, 1, 1, 1, 1, 1}, {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1}} 

but is there a way to ask only for partitions such that no number from the list occurs more than once? So the above would only return {7, 4, 1} WITHOUT finding all the partitions first, because I will be dealing with rather big numbers, so I'm not sure that even if there is a way, it won't freeze my laptop. But do please let me know if you know of any.

edit: I have to check and see how many primes can be made by adding numbers in a set containing 700 integers. Because the set is so big, I can't just ask for all possible subsets, adds their elements and see if their sum is prime. What I'm trying to do is use that set of 700 integers and see if I can express all the primes less than the sum of the set as a combination of some of the elements. Naturally, for larger primes, IntegerPartitions starts coming up with a large number of partitions containing repeated elements, and I can't sort through all of them fast.

here's what I have so far:

t = Table[Prime[i], {i, 1, 669}]; Print[s = Plus @@ t]; c = Length@t; For[i = 670, Prime[i] <= s, i++, If[MemberQ[DuplicateFreeQ /@ IntegerPartitions[Prime[i], Length@t, t],True], c++]]; c

i tried to see if there existed a sum of elements from the list t s.t. no element was used more than once, but this got super slow super fast...

$\endgroup$
1
  • $\begingroup$ Your example specifies the integers to be used, namely {1,4,7}, and that they not be used more than once. Consequently, {7, 4, 1} is the only possible answer, and IntegerPartitions is not needed to determine it, only Total to assure that they add to 12. Perhaps, you mean something different, like specifying only some of the integers to be used. $\endgroup$
    – bbgodfrey
    Mar 7 '15 at 18:51
5
$\begingroup$

This reminds me of a DP (dynamic programming) technique I learned for USACO to solve the knapsack problem. The complexity is $O(n m)$, where $m$ is the number of elements and $n$ is the maximum value (in this case the sum of all the elements). If the average value of an element is $\bar{x}$, then the complexity is $O(n^2\bar{x})$, not too bad.

First I'll define our list of values and call it weights. Note that because of the way the algorithm works, our list needs to be sorted (conveniently Union returns a sorted list). Here I'm just choosing 10 random numbers between 0 and 100.

weights = Union[RandomInteger[100, 10]];

Next I'll initialize our workspace array dp:

dp = ConstantArray[False, Total[weights]];

At step k of the algorithm, dp[[v]] is True if v is a sum of some subset of the first k elements in the list.

Now, here's the meat of the code:

Do[
  With[{w = weights[[k]]},
    Do[
      If[dp[[v - w]], dp[[v]] = True],
      {v, Total[Take[weights, k]], w + 1, -1}
    ];
    dp[[w]] = True;
  ],
  {k, Length[weights]}
]

At each step k, we loop over the array (index v). If dp[[v-w]] is True, that means that v-w is the sum of a subset of the elements. Therefore the value obtained by adding the current element w is also a subset, so we set dp[[v]] true. Note that this only works when we go backwards over the list, so that each of the dp[[v-w]] that we look at is for the previous step, so we don't add w multiple times (if you go forwards you get the making-change problem).

As for the bounds of the loop, we start at Total[Take[weights, k]], the total of the weights used so far, since we know we can't make any values greater than the sum if each element can be added only once). We also start at w + 1, so that v - w is always at least 1. Finally, after each loop we set dp[[w]] to True, since the single element w is a subset of the elements.

After the algorithm runs, dp[[v]] is True if v is the sum of a subset of weights. We can use this code to check our values:

First /@ Position[dp, True] == 
 Union[Total /@ Subsets[weights, {1, \[Infinity]}]]

After verifying that the algorithm works correctly for you, you might try translating it to C or C++ as it will go a lot faster.

Update

I found out that using boolean arrays was extremely slow (something like $O(n^3 m^2)$ according to my tests). If we use 1 for True and 0 for False (like C) then Mathematica tries to use a packed array to hold dp, which is much faster. The updated code follows:

dp = ConstantArray[0, Total[weights]];
Do[
  With[{w = weights[[k]]},
    Do[
      If[dp[[v - w]] == 1, dp[[v]] = 1],
      {v, Total[Take[weights, k]], w + 1, -1}
    ];
    dp[[w]] = 1;
  ],
  {k, Length[weights]}
]
dp = Thread[dp == 1];
$\endgroup$
2
  • $\begingroup$ wow, thanks for writing such a thorough answer! I almost understand it +.+ ... It still seems to run kind of slow, k per second after about 300 iterations. I also just realized that I misunderstood the problem and it will be much harder to solve than i originally thought :( But I'll keep working on it. I've also never used ConstantArray or With before, so if nothing else, at least I'm learning something hopefully XD. Thanks! $\endgroup$
    – Raksha
    Mar 7 '15 at 22:58
  • $\begingroup$ This will probably be much too slow to solve the project Euler problem. Just the fact that the question asks for the last 16 digits of the answer means that you'd have to count more than $10^{16}$ cases, more than could fit in a long int. As with most project Euler questions you'll have to use some math trick to test fewer cases than the total number, and then calculate the total. $\endgroup$ Mar 7 '15 at 23:05
3
$\begingroup$

Given the comment that this relates to a PE problem, I can give the following hint to its solution. In my experience with PE, if they ask for a count of objects then it is not necessary to produce the entire list of objects. In fact, the authors usually construct limits, as in this case, which are so high that it is impossible to construct or store the entire list.

But as @DanielLichtblau hints, what if products instead of sums could be used? What if a product of terms gave you the counts? Might binomial terms correspond to a choice of no more than one of each integer in the allowed set? How would the coefficients of the product relate to partitions of an integer? What if there were a function that would generate the counts and not the entire list?

$\endgroup$
3
  • $\begingroup$ Thanks for the hint! I'll have to think about it :) I did notice that PE problems are beginning to deal with ridiculously big numbers and I suspect there are tricks to dealing with those, I just don't know them and not sure how to even begin looking for them without learning all of number theory in one felt swoop. $\endgroup$
    – Raksha
    Mar 8 '15 at 15:23
  • $\begingroup$ Google the words in italics... $\endgroup$ Mar 8 '15 at 18:51
  • $\begingroup$ To clarify my comment, in a sense I was just joking around as in "how many products formed from {2,3,5...} are prime? But yes, as this response mentions, there is a much easier way to go about the PE problem. Maybe pondering (1+x^2)*(1+x^3)*(1+x^5) will help. $\endgroup$ Mar 12 '15 at 16:42
0
$\begingroup$

Try this on gradually increasing integers and see how it works

FindInstance[12 == a*1 + b*4 + c*7 &&
 (a==0||a==1) && (b==0||b==1) && (c==0||c==1), {a, b, c}]

That does not decide what set you are going to choose from, but you didn't describe that.

If you can revise your question to provide more information about what you really want then I will see if I can improve this answer. As it is, this can still get slow as the numbers and the set to choose from grow in size.

$\endgroup$
5
  • $\begingroup$ the thing is, it's not just a,b,c unfortunately, it's a list of 700 integers to pick from and I have over a million numbers to check whether they can be expressed as a sum of some integers from that list, so I'm not sure FindInstance could handle that in a timely manner, but let me try. $\endgroup$
    – Raksha
    Mar 7 '15 at 18:45
  • $\begingroup$ Ah, THAT kind of information would have been very helpful if it had been included in the original question. Perhaps you could put a few dozen numbers randomly selected from your million and the list of 700 to choose from somewhere that people could try potential solutions on. $\endgroup$
    – Bill
    Mar 7 '15 at 18:51
  • $\begingroup$ Please see clarification. I'm trying to solve this ProjectEuler problem (projecteuler.net/problem=249), so I didn't want to be too specific because I didn't want people to solve it for me. I'm just not super proficient with Mathematica yet, so I wanted a bit of help with the code. $\endgroup$
    – Raksha
    Mar 7 '15 at 19:36
  • $\begingroup$ Since there are 669 primes and each can either be in or out of the set there are 2^669 subsets, each to total and test for primality. Clearly you cannot generate all of those at once, or even one at a time. So there must be some bit of thinking involved to find a way to do this far far more efficiently. So my answer above is never going to help. Fortunately I can't spoil the puzzle for you because at the moment I can't think of any answer to give you. $\endgroup$
    – Bill
    Mar 7 '15 at 20:20
  • 1
    $\begingroup$ Much easier if it required products instead of sums... $\endgroup$ Mar 7 '15 at 21:02
0
$\begingroup$
Reduce[{{a, b, c}.{1, 4, 7} == 12, ## & @@ Thread[0 <= {a, b, c} <= 1]}, {a, b, c}, Integers]
(* a == 1 && b == 1 && c == 1 *)

Reduce[{{a, b, c, d}.{1, 4, 5, 7} == 12,
        ## & @@  Thread[0 <= {a, b, c, d} <= 1]}, {a, b, c, d}, Integers]
(* (a == 0 && b == 0 && c == 1 && d == 1) || (a == 1 && b == 1 &&  c == 0 && d == 1) *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.