24
$\begingroup$

I am looking for the way of building a Table of pairs of numbers in a fast way. My true table evaluates huge functions, and I see no way and reason to show those cumbersome expressions here. Let us for simplicity consider this:

Table[{10 - x - y^2, 1/x - y}, {x, 0.1, 15, 0.5}]

In addition my real table is very long, but for the sake of shortness in this example it has a small amount of terms. Here y is a parameter taking several values. For example, y may be 0.1 and 0.5. Now, I only need the part of the table in which each term in the pair {a, b} is positive and real. In my example here, if y=0.1 one gets

 {{9.89, 9.9}, {9.39, 1.56667}, {8.89, 0.809091}, {8.39, 0.525}, {7.89,
   0.37619}, {7.39, 0.284615}, {6.89, 0.222581}, {6.39, 
  0.177778}, {5.89, 0.143902}, {5.39, 0.117391}, {4.89, 
  0.0960784}, {4.39, 0.0785714}, {3.89, 0.0639344}, {3.39, 
  0.0515152}, {2.89, 0.0408451}, {2.39, 0.0315789}, {1.89, 
  0.0234568}, {1.39, 0.0162791}, {0.89, 0.00989011}, {0.39, 
  0.00416667}, {-0.11, -0.000990099}, {-0.61, -0.00566038}, {-1.11, \
-0.00990991}, {-1.61, -0.0137931}, {-2.11, -0.0173554}, {-2.61, \
-0.0206349}, {-3.11, -0.0236641}, {-3.61, -0.0264706}, {-4.11, \
-0.029078}, {-4.61, -0.0315068}}

but I only need its first 20 terms, which have the both figures positive. It is easy to sort it after the table is build.

The problem is that the expressions entering the real table are huge, and the table is long. In addition the table is a part of a complex demonstration, which is immensely slowed down by the process of the table evaluation. As soon as I change the parameter y from one value to another, it takes about a minute to evaluate everything. Changing to ParallelTable makes the things even worse.

My question: is there a way to instruct Table to stop evaluating as soon as any of the figures in the pair becomes negative? This might considerably shorten its evaluation time.

The Menu/Help/Table mentions a possibility of some specifications in the Table operator, but I have found no examples of such specifications and cannot see, if that would be of help.

Improve this question
$\endgroup$
3
  • 2
    $\begingroup$ Can't you find out where the condition breaks before hand and then only run the relevant number of steps ? $\endgroup$
    – b.gates.you.know.what
    Commented May 2, 2013 at 11:17
  • $\begingroup$ I thank very much all of you. One immediate outcome is that the Table itself has no instruments to control this kind of things. That was my feeling, but I was not sure. $\endgroup$
    – Alexei Boulbitch
    Commented May 6, 2013 at 9:41
  • 1
    $\begingroup$ I went through your solutions. All of them are working, of course. It is difficult in this situation to judge, which one should be called the answer to my questions, since they all do. I, therefore, vote for the shortest one. Thank all of you again. $\endgroup$
    – Alexei Boulbitch
    Commented May 6, 2013 at 9:45

5 Answers 5

Reset to default
12
$\begingroup$

I'd probably use Sow[]/Reap[] for this case, along with Do[]:

With[{y = 0.1}, 
     Reap[Do[
             If[And @@ Positive[temp = {10 - x - y^2, 1/x - y}],
                Sow[temp],
                Break[]],
             {x, 0.1, 15, 0.5}]][[-1, 1]]]

which yields

   {{9.89, 9.9}, {9.39, 1.56667}, {8.89, 0.809091}, {8.39, 0.525}, {7.89, 0.37619},
    {7.39, 0.284615}, {6.89, 0.222581}, {6.39, 0.177778}, {5.89, 0.143902},
    {5.39, 0.117391}, {4.89, 0.0960784}, {4.39, 0.0785714}, {3.89, 0.0639344},
    {3.39, 0.0515152}, {2.89, 0.0408451}, {2.39, 0.0315789}, {1.89, 0.0234568},
    {1.39, 0.0162791}, {0.89, 0.00989011}, {0.39, 0.00416667}}
Improve this answer
$\endgroup$
17
$\begingroup$

Generic short-circuiting Table

Preamble

I interpret your question as a general request for an implementation of Table that would, while supporting the general syntax of Table, support the short-circuiting as well. While the core of the implementation described below uses Reap and Sow, similarly to other answers, the advantage of the present approach is its generality: conditionalTable supports most standard Table specs, including multi-dimensional case.

Illustration

Here are the examples of use (run functions described below to define conditionalTable):

conditionalTable[i, i < 5, {i, 10}]

(* {1, 2, 3, 4}  *)

conditionalTable[{i, j}, i + j < 7, {i, 10}, {j, 5}]

(* {{{1, 1}, {1, 2}, {1, 3}, {1, 4}, {1, 5}}, {{2, 1}, {2,2}, {2, 3}, {2, 4}}} *)

For your specific example:

y = 0.5;
conditionalTable[
  {10 - x - y^2, 1/x - y}, 
  Positive[10 - x - y^2] && Positive[1/x - y], 
  {x, 0.1, 15, 0.5}
]

(* {{9.65, 9.5}, {9.15, 1.16667}, {8.65, 0.409091}, {8.15, 0.125}} *)

Implementation

Here I will present two functions, a general function excTable which allows one to collect intermediate results when some exception has been thrown, and based on it the function conditionalTable proper. The former is a more general-purpose function, while the latter specifically answers the question.

A general exception-based Table emulation

Here is a fairly general function, based on a version of conditional Table implementation described here and here. First, consider a version that would collect data until some tagged exception is thrown, in which case the data collected so far is returned, together with the exception value and tag:

SetAttributes[excTable, HoldAll];
excTable[expr_, iter : {_Symbol, __} ..] := 
   Module[{indices, indexedRes, sowTag, depth = Length[Hold[iter]] - 1,exc, result}, 
      Hold[iter] /. {sym_Symbol, __} :> sym /. Hold[syms__] :> (indices := {syms});
      indexedRes = 
       Replace[#, {x_} :> x] &@
         Last@Reap[
           Catch[Do[Sow[{expr, indices}, sowTag], iter], _, (exc = {##}) &], 
           sowTag
         ];
      result = 
        SplitBy[indexedRes, Array[Function[x, #[[2, x]] &], {depth}]][[##,1]] & @@
           Table[All, {depth + 1}];
      {result, If[! ListQ[exc], {}, exc]}
   ];

For example:

excTable[If[i < 5, i, Throw["Done", myTag]], {i, 10}]

(* {{1, 2, 3, 4}, {"Done", myTag}} *)

If exception is never thrown, the last part of the result is an empty list:

excTable[If[i < 15, i, Throw["Done", excTable]], {i, 10}]

(* {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, {}}  *)

Table with short-circuiting behavior

Now, based on this function, it is easy to construct the one we actually need here:

ClearAll[conditionalTable];
SetAttributes[conditionalTable, HoldAll];
conditionalTable[expr_, test_, iter : {_Symbol, __} ..] :=
  Module[{exc, result},
    result = excTable[If[TrueQ@test, expr, Throw["Done", exc]], iter];
    If[! MatchQ[Last@result , {} | {"Done", exc}],
       Throw @@ Last[result],
       (* else *)
       Return[First@result]
    ]
  ];

It analyzes the exception information, and if some other exception was thrown in the code, it re-throws it, otherwise it returns a (partial) list of results:

conditionalTable[i, i < 5, {i, 10}]

(* {1, 2, 3, 4}  *)
Improve this answer
$\endgroup$
4
  • $\begingroup$ I was trying to evaluate the above expression in Mathematica 12.1, I am facing some error. During evaluation of In[31]:= Throw::nocatch: Uncaught Throw[Done,exc$10311] returned to top level. Out[31]= Hold[Throw["Done", exc$10311]]. I couldn't understand the problem, I hope if you can say some words about it? $\endgroup$
    – L.K.
    Commented Nov 12, 2020 at 13:34
  • $\begingroup$ @L.K. I tried on 12.1 (Mac OS X), and it worked for me. Not sure what went wrong in your case, can't reproduce. What platform are you on? $\endgroup$
    – Leonid Shifrin
    Commented Nov 12, 2020 at 19:52
  • $\begingroup$ I am using Debian 3.38.0. Does it count? $\endgroup$
    – L.K.
    Commented Nov 13, 2020 at 16:53
  • $\begingroup$ @L.K. Well, I can't test that at the moment. One would have to debug to see what is going on. The code is catching all exceptions and then re-throwing if exception happens to be not the one thrown in the code itself. So either exception is not caught, or it is being wrongly re-thrown. Try injecting Print[result]; in between result = ... and If[...] - if Print[...] would fire, it would indicate the former, if not, the latter. In both cases, that might indicate some (regression) bug in Mathematica itself, but more information is needed. $\endgroup$
    – Leonid Shifrin
    Commented Nov 14, 2020 at 7:56
3
$\begingroup$

It sounds like you want to short circuit your evaluation, in that case Table is a bad choice, as it per definition will carry out each iteration no matter what. A better choice is to use a different iterator constructor for instance While:

y = 0.1;
Module[{x = 0.1},
    While[10 - x - y^2 >= 0 && x <= 15,
         (Sow[{10 - x - y^2, 1/x - y}];x = x + 0.5)
    ] // Reap // Last // First
]

For a functional style solution, I suggest using NestWhileList even though you won't actually be using the nesting for anything except keeping track of results: 

SetAttributes[shortTable, HoldAll]
shortTable[code_, test_, {var_, low_, high_, del_}] :=Block[{var},
 NestWhileList[{code /. var -> Last@#, Last@# + del} &,
           {low}, Last@# < high && test /. var -> Last@# &][[2 ;;, 1]]]

With the call being:

shortTable[{10 - x - y^2, 1/x - y}, 10 - x - y^2 >= 0 && 1/x - y >= 0, {x, 0.1, 15, 0.5}]
Improve this answer
$\endgroup$
2
  • $\begingroup$ You don't localize the iterator variable in your recent edit. Try x=10 and then shortTable[...]. Besides, if you really want to make it a scoping construct, better make shortTable HoldAll. $\endgroup$
    – Leonid Shifrin
    Commented May 2, 2013 at 12:04
  • $\begingroup$ @LeonidShifrin Thanks, I've added a block to scope the variable, and I simply forgot the attribute. $\endgroup$
    – jVincent
    Commented May 2, 2013 at 12:13
3
$\begingroup$

If speed is an issue, I think testing for the halting condition is likely to be counterproductive, unless a small proportion of elements of the list fit the condition. The suggestion by @b.gatessucks seems more on target. Whether it works depends on how easy and fast it is to solve for the first point at which the "huge functions" become zero.

Here I make the step size much smaller to illustrate the timings.

tab1 = Module[{y = 0.1, x0, x1, x2},
    x1 = Min[x /. NSolve[First@{10 - x - y^2, 1/x - y} == 0, x]];
    x2 = Min[x /. NSolve[Last@{10 - x - y^2, 1/x - y} == 0, x]];
    x0 = Min[x1, x2, 15];
    Table[{10 - x - y^2, 1/x - y}, {x, 0.1, x0, 0.001}]]; // Timing // First
  (* 0.009297 *)

Comparisons

First, to get a sense of the limit speed, here is how long it takes to generate the whole table:

With[{y = 0.1},
   Table[{10 - x - y^2, 1/x - y}, {x, 0.1, 15, 0.001}]]; // Timing // First
  (* 0.002527 *)

Here we compute the whole table and take the initial positive segment:

tab2 = With[{y = 0.1},
     Take[#, Position[#, _?NonPositive, {2}, 1][[1, 1]] - 1] &@
      Table[{10 - x - y^2, 1/x - y}, {x, 0.1, 15, 0.001}]]; // Timing // First
   (* 0.022767 *)

Edit: Here's another method that takes the initial positive segment:

tabFn = Compile[{{y, _Real}},
  Module[{flag = 1.},
   Table[If[
     flag > 0. && 10 - x - y^2 > 0. && 1/x - y > 0., {10 - x - y^2, 
      1/x - y}, flag = 0.; {0., 0.}], {x, 0.1, 15, 0.001}]
   ]
  ];

tab5 = Cases[#, Except[{0., 0.}]] &@ tabFn[0.1]; // Timing // First
  (* 0.011772 *)

@J.M.'s solution:

tab3 = With[{y = 0.1}, 
     Reap[Do[If[And @@ Positive[temp = {10 - x - y^2, 1/x - y}], 
         Sow[temp], Break[]], {x, 0.1, 15, 0.001}]][[-1, 1]]]; // Timing // First
  (* 0.057492 *)

@LeonidShifrin's solution:

tab4 = With[{y = 0.1}, 
     conditionalTable[{10 - x - y^2, 1/x - y}, 
      10 - x - y^2 > 0 && 1/x - y > 0, {x, 0.1, 15, 0.001}]]; // Timing // First
  (* 0.066421 *)

Check

tab1 == tab2 == tab3 == tab4
  (* True *)

Caveat

First, note that all the methods tested are slower than generating the whole table.

Next, in the first method, being able to efficiently find the point at which to stop the Table is going to be crucial for speed. The sample equations are particularly easy to deal with, but not all equations will be so easy. Also, if most of the table is generated anyway, the desired speedup may be hard to achieve (depending on how efficient the OP's actual method is).

That generating the whole table and selecting the initial positive segment is as fast as it is deserves attention. It suggests that testing the elements might not ever be made fast enough. (Ok, that's going out on a limb -- I'd love to find out I'm wrong.)

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ Yes, whenever feasible, it is better to just manually reckon out where your Table[] is supposed to stop under your set conditions. Of course, that requires thought, and not many people seem to like doing that... in the case of generating the entire table and then just cherry-picking what is wanted, I would say this is again one of the tough choices of "speed or storage". $\endgroup$
    – J. M.'s missing motivation ♦
    Commented May 2, 2013 at 12:38
  • 1
    $\begingroup$ In the general case you are not guaranteed that you can perform your limit test globally, and you are left in the situation that calculating the range of elements you would want to iterate is effectively the same as iterating them. Though for the model case given this is naturally not the situation. As for this case, I think the results will depend greatly on how large you make your table, and you didn't really make it all that large. $\endgroup$
    – jVincent
    Commented May 2, 2013 at 12:52
  • $\begingroup$ In this simple example, I don't think much changes if the list is increased by diminishing the step size. The other parameters, the functions and the resulting range to be iterated over, will determine which approach is best in a particular case. $\endgroup$
    – Michael E2
    Commented May 2, 2013 at 13:33
1
$\begingroup$

If you somehow don't like Do, Table, Reap and Sow (I don't know where you'd get that idea ;) ), you can also use Fold in the following way

Clear[collector]
y = 0.1;
kkkk = 20;
xRange = Table[x, {x, 0.1, 15, 0.5}];
Module[{group},
 With[{kkkk = kkkk},
  collector[{list_, n_}, elem_] := 
   If[n == kkkk, Throw[list], 
    If[And @@ Positive[elem], {group[list, elem], n + 1}]]
  ];
 With[{y = y},
  {DeleteCases[
    Catch[Fold[
      Function[collector[#, {10 - #2 - y^2, 1/#2 - y}]], {group, 0}, 
      xRange]], group, Infinity, Heads -> True]}
  ]
 ]

The answer is similar to that of J.M., but here I use Throw to exit Fold and I use Catch to catch the value. A function collector that takes a linkedlist as its first arguments maintains the positive pairs we have found so far. collector also remembers how many such values we have found.

The use of DeleteCases to go from a linked list to a normal list is perhaps a bit strange. But I think it is efficient this way. Feedback is welcome!

Remark

I could also have written

Clear[collector]

SetAttributes[llToken, HoldAll];
fromJLinkedList[ll_] := 
  List@DeleteCases[ll, llToken, Infinity, Heads -> True];

y = 0.1;
kkkk = 20;
xRange = Table[x, {x, 0.1, 15, 0.5}];

collector[{list_, n_}, elem_] := 
 If[n == kkkk, Throw[list], 
  If[And @@ Positive[elem], {llToken[list, elem], n + 1}]]

fromJLinkedList@
 Catch[Fold[
   Function[collector[#, {10 - #2 - y^2, 1/#2 - y}]], {llToken, 0}, 
   xRange]]
Improve this answer
$\endgroup$
4
  • $\begingroup$ In my opinion this seems like a very counter productive solution. Fold is used as the loop constructor, but not because it nicely fits the problem, rather you needed to build a heap of scaffolding around it to make it work. The typical use case of fold is a loop where each iteration depends on the output of the last, which is not the case in this problem, every iteration depends only on the state of the iterators, and the only problem to solve is how to allow short circuiting. $\endgroup$
    – jVincent
    Commented May 2, 2013 at 11:33
  • $\begingroup$ @jVincent Note that the use of With and Module is only respectively speed/tidy things up and provide a wrapper to use in linkedlists. If you assume linkedlist building functions are already present almost all the scaffolding can be made to disappear. As I maintain values found so far in a function, recursion and therefore Fold quickly come to mind. $\endgroup$
    – Jacob Akkerboom
    Commented May 2, 2013 at 11:40
  • $\begingroup$ Well that really was my point. You don't need this particular recursion pattern, but you chose it as a method of collecting results and thus end up using a loop constructor not because it fits the problem but because it fits your chosen method of collecting results. This seems counter productive, at the same time if you really wanted a "functional" style solution you should arguably have used a fixed point iteration since you don't want a fixed number of iterations but a short circuit iteration, thus you should have used either FixedPoint or NestWhile not fold. $\endgroup$
    – jVincent
    Commented May 2, 2013 at 11:49
  • $\begingroup$ I've added a NestWhileList solution to my answer to show what I mean. The solution is much more concise, yet it still doesn't actually use any of the iteratively passed on results for anything other than book keeping. $\endgroup$
    – jVincent
    Commented May 2, 2013 at 11:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.