# How to simplify and shorten pattern code?

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[] == x[] || x[] == x[]]


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[] == x[] || x[] == x[] || x[] == x[] ||
x[] == x[] || x[] == x[] || x[] == x[] ||x[] == x[]]


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

• Select[ip, Max @@ # < s && Length@DeleteDuplicates@# == m &] Apr 7, 2015 at 12:41
• 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? Apr 7, 2015 at 12:46
• 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 Apr 7, 2015 at 12:49
• @penguin77 Yes his thas {{9, 5, 1}=15,{6, 5, 4}=15}..... Apr 7, 2015 at 12:50
• @belisarius your code is 3 time slower than my.How to speed up? Apr 7, 2015 at 12:52

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@# &]

• Total == 15? That's already guaranteed by IntegerPartitions[n]. Apr 7, 2015 at 13:16
• @rcollyer, yes of course, thx, i will correct. Apr 7, 2015 at 13:22
• 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. Apr 7, 2015 at 13:22
• Oh, and DuplicateFreeQ was genius. Apr 7, 2015 at 13:23
• @penguin77 .Code of Michael E2 is best. Operating time is the shortest. Apr 7, 2015 at 13:24

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 *)


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 n = 45; s = 15; m = 8;
ip3 = IntegerPartitions[n, {m}];
v3 = Pick[ip3, (Unequal @@ # && Max@# < s) & /@ ip3];
v3 // Grid • I believe you may replace Max by Firstsince the tuples are already sorted. That should be faster (at least theoretically) Apr 7, 2015 at 13:41
• @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. Apr 7, 2015 at 13:45
• @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];] Apr 7, 2015 at 13:47
• @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.
– kglr
Apr 7, 2015 at 14:18
• True, that's really better. Apr 7, 2015 at 14:20

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]
`
• .....................Thanks :) Apr 7, 2015 at 13:11
• @Mariusz the answers have barely started to come in. You should wait a while before accepting an answer. Apr 7, 2015 at 13:15
• @rcollyer. What should I wait? But already the answer is correct. This has just wanted to. Apr 7, 2015 at 13:29
• @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. Apr 7, 2015 at 13:40