# 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[[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?

• Select[ip, Max @@ # < s && Length@DeleteDuplicates@# == m &] Apr 7 '15 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 '15 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 '15 at 12:49
• @penguin77 Yes his thas {{9, 5, 1}=15,{6, 5, 4}=15}..... Apr 7 '15 at 12:50
• @belisarius your code is 3 time slower than my.How to speed up? Apr 7 '15 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 '15 at 13:16
• @rcollyer, yes of course, thx, i will correct. Apr 7 '15 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 '15 at 13:22
• Oh, and DuplicateFreeQ was genius. Apr 7 '15 at 13:23
• @penguin77 .Code of Michael E2 is best. Operating time is the shortest. Apr 7 '15 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 '15 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 '15 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 '15 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 '15 at 14:18
• True, that's really better. Apr 7 '15 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 '15 at 13:11
• @Mariusz the answers have barely started to come in. You should wait a while before accepting an answer. Apr 7 '15 at 13:15
• @rcollyer. What should I wait? But already the answer is correct. This has just wanted to. Apr 7 '15 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 '15 at 13:40