2
$\begingroup$

Well, I am trying to execute the following code:

Clear["Global`*"];
n = 252;
k = 7;
f[x_] := Select[Min[Counts[Flatten@x] /@ #] > 1 &]@x;
f@Select[DuplicateFreeQ[#] && FreeQ[#, 0] &]@IntegerPartitions[n, {k}]

Which finds the IntegerPartitions[252] (and there are $269232701252579$ partitions for that specific number) and delete the solutions that contain a zero or two or more times the same number in the solution. But my code keeps crashing, I think because $269232701252579$ is too big.

I have one question:

Is there a way to execute the above code without the crash?

$\endgroup$
3
  • 1
    $\begingroup$ For exactly 3 numbers try IntegerPartitions[10, {3}]. The online documentation for IntegerPartitions has more details. $\endgroup$
    – JimB
    Jan 14 at 22:12
  • $\begingroup$ @JimB Sorry, I see. I edited my question. $\endgroup$ Jan 14 at 22:14
  • 3
    $\begingroup$ What do you mean by "no zero"? IntegerPartitions doesn't produce any zeros. $\endgroup$
    – JimB
    Jan 14 at 22:17
4
$\begingroup$

It's faster to construct the partitions with no repetitions directly instead of constructing all partitions and then eliminate those with duplicates:

n = 252;
k = 7;
a = Select[IntegerPartitions[n, {k}], DuplicateFreeQ]; // AbsoluteTiming
b = # + Range[k - 1, 0, -1] & /@ IntegerPartitions[n-k*(k-1)/2, {k}]; // AbsoluteTiming
a == b

(*    {63.0103, Null}    *)
(*    {32.3662, Null}    *)
(*    True               *)

In this case the construction of b took about half as long as a. The difference may be even more pronounced for larger sets.

Also, by doing the application of # + Range[k - 1, 0, -1] & in a more efficient way, or finding a way to avoid it, you can further increase speed.

$\endgroup$
4
  • $\begingroup$ Thanks for your answer. And how can I delete the solutions that use numbers that turn up ones? $\endgroup$ Jan 15 at 10:59
  • $\begingroup$ I don't understand what you mean: "...that turn up ones", what does that mean? $\endgroup$
    – Roman
    Jan 15 at 11:01
  • $\begingroup$ Can you take a look at @JimB's answer. Under the 75 seconds there is a explanation what the function $f$ does. $\endgroup$ Jan 15 at 11:02
  • $\begingroup$ As @JimB says, only 231 and 230 don't occur twice: Cases[Tally[Flatten[a]], {x_, 1} -> x] gives {231, 230}. Should be easy to eliminate. $\endgroup$
    – Roman
    Jan 15 at 11:18
3
$\begingroup$

First, generate the sequences without applying f:

Clear["Global`*"];
n = 252;
k = 7;
results = Select[DuplicateFreeQ[#] &]@IntegerPartitions[n, {k}];
Length[results]
(* 49929373 *)

This takes about 75 seconds.

It appears that the function f selects lists in results for which all numbers occur at least twice in results. The numbers to be removed are the ones that only occur once which can only involve the largest numbers and the largest number in this case is 231 = 252 - (1+2+3+4+5+6). So we can check on the frequency of numbers 231, 230, ..., etc. until the frequency is larger than 1.

IntegerPartitions makes this convenient in that the numbers in each list are sorted from high to low, and the lists are sorted by the first element from high to low.

Looking at the first 10 rows in results we see

results[[1 ;; 10]] // TableForm

First 10 rows

Numbers 231 and 230 only occur once so rows 1 and 2 can be deleted.

results = results[[2 ;;]];

I'm assuming that getting results specifically for 252 is your objective so something more formal (i.e., not using the "by hand" work) is not necessary.

$\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.