1
$\begingroup$

I have this code for sorting only those tuples that sum to 15 without repetition:

n = 15;s=11; m = 3; 
ip = IntegerPartitions[n, {m}]; 
v =  Pick[ip, Max@# < s & /@ ip];
DeleteCases[v, x_ /; x[[1]] == x[[2]] || x[[2]] == x[[3]]]

Output:

{{9, 5, 1}, {9, 4, 2}, {8, 6, 1}, {8, 5, 2}, {8, 4, 3}, {7, 6, 2}, {7, 5, 3}, {6, 5, 4}}

but with: 

n = 45;s = 15;m = 8;
ip = IntegerPartitions[n, {m}]; 
v = Pick[ip, Max@# < s & /@ ip];
DeleteCases[v, x_ /; x[[1]] == x[[2]] || x[[2]] == x[[3]] || x[[3]] == x[[4]] || 
  x[[4]] == x[[5]] || x[[5]] == x[[6]] || x[[6]] == x[[7]] ||x[[7]] == x[[8]]]

Pattern in DeleteCases[] is too long. How to write code in a simpler and more elegant way?

Improve this question
$\endgroup$
7
  • $\begingroup$ Select[ip, Max @@ # < s && Length@DeleteDuplicates@# == m &] $\endgroup$
    – Dr. belisarius
    Apr 7, 2015 at 12:41
  • $\begingroup$ Max@# < s & /@ ip does not give total sum of 15, but sublists with max value smaller than s. Somehow, did I missed understanding your question? $\endgroup$
    – penguin77
    Apr 7, 2015 at 12:46
  • $\begingroup$ Your code seems to produce: {{10, 4, 1}, {10, 3, 2}, {9, 5, 1}, {9, 4, 2}, {8, 6, 1}, {8, 5, 2}, {8, 4, 3}, {7, 6, 2}, {7, 5, 3}, {6, 5, 4}} and not the output, shown in your question $\endgroup$
    – penguin77
    Apr 7, 2015 at 12:49
  • $\begingroup$ @penguin77 Yes his thas {{9, 5, 1}=15,{6, 5, 4}=15}..... $\endgroup$
    – Mariusz Iwaniuk
    Apr 7, 2015 at 12:50
  • $\begingroup$ @belisarius your code is 3 time slower than my.How to speed up? $\endgroup$
    – Mariusz Iwaniuk
    Apr 7, 2015 at 12:52

3 Answers 3

Reset to default
2
$\begingroup$

You may consider this to produce same result as your code:

n = 15; s = 11; m = 3;
ip = IntegerPartitions[n, {m}];
Select[ip, Max @@ # < s && DuplicateFreeQ@# &]
Improve this answer
$\endgroup$
6
  • $\begingroup$ Total == 15? That's already guaranteed by IntegerPartitions[n]. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:16
  • $\begingroup$ @rcollyer, yes of course, thx, i will correct. $\endgroup$
    – penguin77
    Apr 7, 2015 at 13:22
  • 2
    $\begingroup$ The only reason I focused on your answer was I was working on the same thing ... That said, I'd use Max[#] < s && DuplicateFreeQ[#] & for your predicate in Select as Apply is unnecessary for Max to work and it doesn't unpack. Also, if you pack ip, e.g. DeveloperToPackedArray@IntegerPartitions[n, {m}];` even with n = 45, it's faster than Pick. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:22
  • $\begingroup$ Oh, and DuplicateFreeQ was genius. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:23
  • $\begingroup$ @penguin77 .Code of Michael E2 is best. Operating time is the shortest. $\endgroup$
    – Mariusz Iwaniuk
    Apr 7, 2015 at 13:24
5
$\begingroup$

Update: Use the third argument of IntegerPartitions to get further simplification:

n = 15; s = 11; m = 3;
ipa = IntegerPartitions[n, {m}, Range[s - 1]]

Using it in Pick with @penguin77's DuplicateFreeQ or with @Michael E2's Unitize[...]:

va1 = Pick[ipa, DuplicateFreeQ /@ ipa];
va2 = Pick[ipa, Unitize[Times @@ Differences@Transpose[ipa]] , 1]
va1 == va2 == v2
(* True *)

Original answer:

You can modify the selector array (the second argument) inside Pick to get the result in one step:

n = 15; s = 11; m = 3;
ip2 = IntegerPartitions[n, {m}];
v2 = Pick[ip2, (Unequal @@ # && Max@# < s) & /@ ip2];
v2 // Grid

enter image description here

n = 45; s = 15; m = 8;
ip3 = IntegerPartitions[n, {m}];
v3 = Pick[ip3, (Unequal @@ # && Max@# < s) & /@ ip3];
v3 // Grid

enter image description here

Improve this answer
$\endgroup$
6
  • $\begingroup$ I believe you may replace Max by Firstsince the tuples are already sorted. That should be faster (at least theoretically) $\endgroup$
    – Dr. belisarius
    Apr 7, 2015 at 13:41
  • $\begingroup$ @belisarius I don't see any speed difference between using Max and First. But, switching from Unequal @@ # to DuplicateFreeQ@# does give a speed up. Note, these are still small, and Michael's is an order of magnitude faster. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:45
  • $\begingroup$ @rcollyer That was why I said "theoretically" : s=10; ip = RandomInteger[{1, 10}, {10000, 1000}]; Print@Timing[Pick[ip, (Max@# < s) & /@ ip];]; Print@Timing[Pick[ip, (First@# < s) & /@ ip];] $\endgroup$
    – Dr. belisarius
    Apr 7, 2015 at 13:47
  • $\begingroup$ @belisarius, good point re First vs Max, thank you. We can eliminate the need for either by using the third argument of IntegerPartitions in construction of ip. $\endgroup$
    – kglr
    Apr 7, 2015 at 14:18
  • $\begingroup$ True, that's really better. $\endgroup$
    – Dr. belisarius
    Apr 7, 2015 at 14:20
1
$\begingroup$

This produces the same output as your code:

Pick[ip,
 UnitStep[(s - 1) - ip[[All, 1]]] Unitize[Times @@ Differences@Transpose[ip]], 1]
(*
  {{10, 4, 1}, {10, 3, 2}, {9, 5, 1}, {9, 4, 2}, {8, 6, 1},
   {8, 5, 2}, {8, 4, 3}, {7, 6, 2}, {7, 5, 3}, {6, 5, 4}}
*)

To get the output written in the question, adjust as follows:

Pick[ip,
 UnitStep[(s - 2) - ip[[All, 1]]] Unitize[Times @@ Differences@Transpose[ip]], 1]
Improve this answer
$\endgroup$
4
  • $\begingroup$ .....................Thanks :) $\endgroup$
    – Mariusz Iwaniuk
    Apr 7, 2015 at 13:11
  • $\begingroup$ @Mariusz the answers have barely started to come in. You should wait a while before accepting an answer. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:15
  • $\begingroup$ @rcollyer. What should I wait? But already the answer is correct. This has just wanted to. $\endgroup$
    – Mariusz Iwaniuk
    Apr 7, 2015 at 13:29
  • 2
    $\begingroup$ @Mariusz because choosing an answer discourages further answers which may or may not be better, but illustrate some other way of doing things. Or, discuss issues that you haven't considered. There are usually 8 or 9 ways to accomplish most things in Mathematica. Also, it is not uncommon for a late answer to completely alter a view of a problem, for example:(1), (2). So, holding off, even for a couple of hours gives others a chance at being noticed. $\endgroup$
    – rcollyer
    Apr 7, 2015 at 13:40

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.