1
$\begingroup$

I have already made this and the question is really about "how to make this faster and more general (to save the 4 keypresses of D,o,[ and ] that have to be made per-parameter)"

The function:

Reap[Do[Do[
Do[If[i + j + k > 6, Sow[Join[{i + j + k}, {{i, j, k}}]], 
  Nothing], {k, 3}], {j, 3}], {i, 3}]] // AbsoluteTiming

Output:

{0.0000826, {Null, {{{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 
  2}}, {8, {2, 3, 3}}, {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 
  3}}, {7, {3, 3, 1}}, {8, {3, 3, 2}}, {9, {3, 3, 3}}}}}}

The function essentially just does what Table[] does; aka it spits out all permutations of the variables and corresponding info that you feed into it, then deletes all of the entries that fail to comply to some constraints (in my example: i+j+k>6).

However the whole point is to do this deletion thingy as it is building the table instead of build the table first then check-and-delete which potentially ends up with 90%+ zero values or whatever we use for "nothing complies with the given constraints"; furthermore I do not care about the structure because I would massively prefer storing the actual values of the arguments (the numbers) instead of figuring out which nest of what nest some value is.

I have searched a bit about this and found about 2-3 very relevant threads here however none of which I believe have the exact thing that I want; my favourite of which is this thread https://stackoverflow.com/questions/6367932/generate-a-list-in-mathematica-with-a-conditional-tested-for-each-element

Specifically Leonid Shifrins answer.

His function with my example outputs:

{0.0002925, {{{7}}, {{7}, {7, 8}}, {{7}, {7, 8}, {7, 8, 9}}}}

(that is with AbsoluteTiming as well)

As you can see Shifrins code "loses information" about the values used to generate this. In other words if you only look at the output, you have no clue as to what made that first 7 for instance, it can be 7+0, 0+7, 3+4, 1+1+5, square root of 49, etc etc. I just want to store that information for each successful condition-pass instead of tossing it.

Also I believe I double evaluate which I would like to get rid of but all of my tries came out as infinite recursion (there is i+j+k inside Sow but also inside the conditional, so its evaluated twice where it doesnt need to be, in theory)

Thanks in advance.

$\endgroup$
5
  • $\begingroup$ Does Table[{k, Flatten[Permutations /@ IntegerPartitions[k, {3}, Range[3]], 1]}, {k, 7, 9}] suit your needs? $\endgroup$ – J. M.'s ennui Jan 2 at 16:53
  • $\begingroup$ No, it is a more special case instead of more general. Saying x>6 is not equivalent to saying x€[7,9]. There can be more constraints and some with functions that have i or j or k as arguments etc. Furthermore i j k should be able to use some (positive) real increment which i left as 1 in my example. I should've been more clear perhaps but then it would be harder to explain, lets just say I am looking for a more generalized case in general. The idea of bunching the arguments that produce the same value under the same value is cool though, I will ponder about that. $\endgroup$ – redivider Jan 2 at 17:06
  • $\begingroup$ how about Reap[Do[If[i + j + k > 6, Sow[{i + j + k, {i, j, k}}], Nothing], {i, 3}, {j, 3}, {k, 3}]][[2]]? $\endgroup$ – kglr Jan 3 at 12:21
  • $\begingroup$ ... or Reap[Do[If[(v=i + j + k) > 6, Sow[{v, {i, j, k}}], Nothing], {i, 3}, {j, 3}, {k, 3}]][[2]]? $\endgroup$ – kglr Jan 3 at 12:27
  • $\begingroup$ Yes! I completely forgot for some reason that you can iterate over multiple variables inside 1 Do; this way 'v' can also be defined outside the whole thing, still making it faster than Shifrins code, thanks! You can make an answer so I can upvote you if you want, If I can upvote, not sure. $\endgroup$ – redivider Jan 3 at 12:50
2
$\begingroup$

Do does take multiple iterators. So, you can do

Reap[Do[If[i + j + k > 6, Sow[{i + j + k, {i, j, k}}]], {i, 3}, {j, 3}, {k, 3}]][[2]] 
{{{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 2}}, {8, {2, 3, 3}}, 
  {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 3}}, {7, {3, 3, 1}}, 
  {8, {3, 3, 2}}, {9, {3, 3, 3}}}} 

You can calculate i+j+k once for each step using something like:

Reap[Do[If[(v = i + j + k) > 6, Sow[{v, {i, j, k}}]], {i, 3}, {j, 3}, {k, 3}]][[2]] 

same result

You can also define a function similar to Simon's tableGenAlt:

ClearAll[f0]
f0 = Module[{ij = {##3}[[All, 1]]}, 
  Reap[Do[If[#2[# @@ ij], Sow[{# @@ ij, ij}]], ##3]][[2]]] &;

f0[Plus, GreaterThan[6], {i, 3}, {j, 3}, {k, 3}]
{{{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 2}}, {8, {2, 3, 3}}, 
  {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 3}}, {7, {3, 3, 1}}, 
  {8, {3, 3, 2}}, {9, {3, 3, 3}}}} 

Using a slight modification we can have more general test functions in the second argument:

ClearAll[f1]
f1 = Module[{ij = {##3}[[All, 1]]}, 
   Reap[Do[If[#2 @@ ij, Sow[{# @@ ij, ij}]], ##3]][[2]]] &;

f1[Plus, GreaterThan[6] @* Plus, {i, 3}, {j, 3}, {k, 3}] 
{{{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 2}}, {8, {2, 3, 3}}, 
  {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 3}}, {7, {3, 3, 1}}, 
  {8, {3, 3, 2}}, {9, {3, 3, 3}}}} 
f1[Plus, Apply[And] @* OddQ @* List, {i, 3}, {j, 3}, {k, 3}] 
{{{3, {1, 1, 1}}, {5, {1, 1, 3}}, {5, {1, 3, 1}}, {7, {1, 3, 3}},
 {5, {3, 1, 1}}, {7, {3, 1, 3}}, {7, {3, 3, 1}}, {9, {3, 3, 3}}}} 
f1[FOO, OddQ @* Times, {i, 3}, {j, 3}, {k, 3}] 
{{{FOO[1, 1, 1], {1, 1, 1}}, {FOO[1, 1, 3], {1, 1, 3}}, 
 {FOO[1, 3, 1], {1, 3, 1}}, {FOO[1, 3, 3], {1, 3, 3}}, 
 {FOO[3, 1, 1], {3, 1, 1}}, {FOO[3, 1, 3], {3, 1, 3}},
 {FOO[3, 3, 1], {3, 3, 1}}, {FOO[3, 3, 3], {3, 3, 3}}}} 
$\endgroup$
1
$\begingroup$

I think a slightly modified version of Leonid's tableGenAlt should do what you need.

ClearAll[tableGenAlt];
SetAttributes[tableGenAlt, HoldAll];
tableGenAlt[expr_, test_, iter__List] := 
  Module[{sowTag, v = Hold[iter][[All, 1]]},
   First[Last@Reap[
      Do[If[test[#], Sow[{#, {ReleaseHold@v}}, sowTag]] &[expr], iter], 
        sowTag], {}]];

tableGenAlt[i + j + k, GreaterThan[6], {i, 3}, {j, 3}, {k, 3}]
(* {{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 2}}, {8, {2, 3, 
   3}}, {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 3}}, {7, {3, 3, 
   1}}, {8, {3, 3, 2}}, {9, {3, 3, 3}}} *)
$\endgroup$
0
$\begingroup$

By choosing the indices right, you can get this using a single Table:

Flatten[Table[{i + j + k, {i, j, k}}, {i, 3}, {j, 4 - i, 3}, {k, 
   7 - i - j, 3}], 2]

This gives:

{{7, {1, 3, 3}}, {7, {2, 2, 3}}, {7, {2, 3, 2}}, {8, {2, 3, 
   3}}, {7, {3, 1, 3}}, {7, {3, 2, 2}}, {8, {3, 2, 3}}, {7, {3, 3, 
   1}}, {8, {3, 3, 2}}, {9, {3, 3, 3}}}
$\endgroup$
1
  • $\begingroup$ Perhaps I should completely re-do my post somehow; It is not about making a problem fit the tool so that you get the wanted solution, it is about making the tool accommodate the generalized problem and getting the wanted solution $\endgroup$ – redivider Jan 2 at 18:37

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.