How to simplify and shorten pattern code?

Question

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 &] — Dr. belisarius, Apr 07 '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? — penguin77, Apr 07 '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 — penguin77, Apr 07 '15 at 12:49
@belisarius your code is 3 time slower than my.How to speed up? — Mariusz Iwaniuk, Apr 07 '15 at 12:52
@penguin77. You're right because I explained with google translator, perhaps because the question is wrong the wording.Google translator suck ;) — Mariusz Iwaniuk, Apr 07 '15 at 12:59

kglr · Answer 1 · 2018-02-06T20:06:31.293

5

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

edited Feb 06 '18 at 20:06

answered Apr 07 '15 at 13:11

kglr

394,356
18
477
896

I believe you may replace Max by Firstsince the tuples are already sorted. That should be faster (at least theoretically) – Dr. belisarius Apr 07 '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. – rcollyer Apr 07 '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];] – Dr. belisarius Apr 07 '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 07 '15 at 14:18
True, that's really better. – Dr. belisarius Apr 07 '15 at 14:20
+1 for using the third argument of IntegerPartitions – Mr.Wizard Apr 07 '15 at 16:44

penguin77 · Accepted Answer · 2015-04-07T13:17:47.993

2

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

edited Apr 07 '15 at 13:17

answered Apr 07 '15 at 12:52

penguin77

1,645
9
8

Total == 15? That's already guaranteed by IntegerPartitions[n]. – rcollyer Apr 07 '15 at 13:16
@rcollyer, yes of course, thx, i will correct. – penguin77 Apr 07 '15 at 13:22
2

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 withn = 45, it's faster thanPick`. – rcollyer Apr 07 '15 at 13:22
Oh, and DuplicateFreeQ was genius. – rcollyer Apr 07 '15 at 13:23
@penguin77 .Code of Michael E2 is best. Operating time is the shortest. – Mariusz Iwaniuk Apr 07 '15 at 13:24
@rcollyer yes, good point! on M9, Max @ # seems to be about 33% faster than Max @@ # , – penguin77 Apr 07 '15 at 14:21

score 1 · Answer 3 · answered Apr 07 '15 at 13:06

1

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]

answered Apr 07 '15 at 13:06

Michael E2

235,386
17
334
747

.....................Thanks :) – Mariusz Iwaniuk Apr 07 '15 at 13:11
@Mariusz the answers have barely started to come in. You should wait a while before accepting an answer. – rcollyer Apr 07 '15 at 13:15
@rcollyer. What should I wait? But already the answer is correct. This has just wanted to. – Mariusz Iwaniuk Apr 07 '15 at 13:29
2

@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. – rcollyer Apr 07 '15 at 13:40

How to simplify and shorten pattern code?

3 Answers3