difference of speed in making a Table - wolfram-mathematica

I was reading a useful post at WRI blog on improving speed of code, and I need help in understanding this one.
Compare these speeds
Timing[
tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];
]
{0.031, Null}
and
Timing[
a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
{0.422, Null}
So it is much faster when putting the actual value for the limit inside the table itself vs outside. The explanation for this, which I am sure it is correct, but I need help in understanding, is that Table is compiled if its limit are numeric vs. not, this is because its Attributes is HoldAll.
But my question is: How would the above actually work, because the limits to Table must, at one point, become numeric anyway? I can't write
Clear[a]
tbl = Table[i + j, {i, 1, a}, {j, 1, a}]
The above gives an error.
So, for me, writing a=1000 outside Table vs. inside, should have made no difference, since without a having a numerical value, Table[] can't do anything. So the replacing of a by the number 1000 must occur at one point of time by evaluator before Table[] can do anything useful, would it not?
In other words, what Table should see, eventually, is {i, 1, 1000}, {j, 1, 1000} in both cases.
So, the way I thought this would happen is this:
Evaluator replaces a by 1000 in the arguments of table
Evaluator calls Table with the result, which is now all numeric.
Table Compiles, and runs faster now.
But what seems to happen is something else. (due to HoldAll ?)
Table takes its arguments, as is. Since it has HoldAll, so it sees a and not 1000.
It does not call Compile since its arguments are not all numbers.
It now generate a table with the a limit, Evaluator evaluates a to 1000
Table is generated now all limits are numeric, but slower now since code is not compiled.
Question is: Does the above sort of what happens? Could someone explain the steps that would have happened to explain this difference in timing?
Also, how would one insure that Table is Compiled in both cases in the above example, even if one uses a variable for the limit? It is not always possible to hardcode the numbers for the table limits, but one must sometime use a variables for these. Should one explicitly use the Compile command? (I do not use Compile directly, since I assumed it is done automatically when needed).
edit(1)
In answer to post by Mike below on finding no difference in timing when using a call.
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[a]]
]
gives
{0.031, True}
But that is because a is now the number 1000 INSIDE the function, once it is called. Since M passes things by VALUE.
If we force the call to be by reference, so that a is left unevaluated, then we get
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[Unevaluated#a]]
]
now we see the expected result, since now a is still symbolic INSIDE the function, we are back to square one, and now it is slow, since not packed. And since it is not packed, Compile is not used.
{0.437, False}
edit(2)
Thanks to everyone for the answers, I think I learned allot from them.
Here is an executive summary, just to make sure I got everything ok.
edit(3)
Here are links I have specially related to hints to use to making Mathematica code runs faster.
http://library.wolfram.com/howtos/faster/
http://blog.wolfram.com/2011/12/07/10-tips-for-writing-fast-mathematica-code/
https://stackoverflow.com/questions/4721171/performance-tuning-in-mathematica
Using Array and Table Functions in Mathematica. Which is best when

So this is what I think is happening. The reason why you see the slow down between a numeric and a symbolic limit on Table is due to the fact that you do a double index. Each sub-table (e.g. going over all indices j for a fixed index i) is constructed separately and when the limit is symbolic there is an extra step involved in figuring out that limit before constructing each sub table. You can see this by examining, e.g.
Trace[a = 3;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
David gives a good example for why you would want to do this check for every sub list. As to why Mathematica cannot figure out when this check is not needed I have no clue. If you only have one index to sum over there is no difference in speed between the symbolic and numeric version
Timing[tbl = Table[i + j, {j, 1, 1000}];]
{0.0012, Null}
Timing[a = 1000;
tbl = Table[i + j, {j, 1, a}];
]
{0.0013, Null}
To answer your follow up regarding speed; making tbl a function is faster for both numeric and symbolic limits.
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
tblFunc[a];
]
{0.045171, Null}
vs.
Timing[tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];]
{0.066864, Null}
Timing[a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
]
{0.632128, Null}
You gain even more speed if you intend to reuse the tbl construction.
b=1000;
Timing[tblFunc[b];]
{0.000013, Null}

The key things to monitor, as others have mentioned, are packing and list length. I actually don't see the differences that Timo reports:
ClearAll[tblFunc];
Timing[a = 1000;
tblFunc[a_] := Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tblFunc[a]]]
{0.077706, True}
vs
ClearAll[tbl];
Timing[
tbl = Table[i + j, {i, 1, 1000}, {j, 1, 1000}];
Developer`PackedArrayQ[tbl]]
{0.076661, True}
ClearAll[tbl];
Timing[a = 1000;
tbl = Table[i + j, {i, 1, a}, {j, 1, a}];
Developer`PackedArrayQ[tbl]]
{1.02879, False}
So for me the only difference is if the list is packed. Whether it is a function makes no difference to timing on my set up. And as expected when you switch off autocompilation the timings are the same for all of the above because no packing occurs:
SetSystemOptions["CompileOptions" -> {"TableCompileLength" -> Infinity}];
{1.05084, False}
vs
{1.00348, False}
{1.01537, False}
reset the table autocompile length:
SetSystemOptions["CompileOptions" -> {"TableCompileLength" -> 250}]

This is slightly OT, but for speed here you might want to avoid using the item-by-item processing that's implicit in using Table. Rather, use Outer. Here's what I'm seeing on my system:
Timing[Outer[Plus, Range[5000], Range[5000]];]
{0.066763,Null}
Timing[Table[i + j, {i, 1, 5000}, {j, 1, 5000}];]
{0.555197,Null}
Quite a dramatic difference.

Related

Speed up symbolic claculation with mathematica

I have wirtten the following code. It is a code for mathematica and I would like to do some "simple" linear algebra with symbols.
The code sets up a matrix (called A) and a vector (called b). Then it solves the euqation A*k=b for k.
Unfortunately, my code is super slow, e.g. for n=5 it takes hours.
Is there any better way for solving this problem? I am not that familiar with mathematica and my code is rather unprofessional, so do you have any hints for speeding things up?
Here is my code.
clear[all];
n = 3;
MM = Table[Symbol["M" <> ToString#i], {i, 1, n}];
RB = Table[
Symbol["RA" <> FromCharacterCode[65 + i] <> ToString#(i + 1)], {i,
1, n - 1}];
mA = Table[Symbol["mA" <> FromCharacterCode[65 + i]], {i, 1, n - 1}];
mX = Table[
Symbol["m" <> FromCharacterCode[65 + i] <> "A"], {i, 1, n - 1}];
R = Table[
Symbol["R" <> FromCharacterCode[64 + i] <> ToString#(j + 1)], {i,
1, n}, {j, 1, n - 1}];
b = Table[-MM[[1]]*(1/(mA[[i]]*(R[[1, i]] - RB[[i]])) -
1/(mX[[i]]*(-R[[i + 1, i]] + RB[[i]]))), {i, 1, n - 1}];
A = Table[
MM[[j + 1]]*(R[[1, j]]/(mA[[i]]*(R[[1, i]] - RB[[i]])) -
R[[i + 1, j]]/(mX[[i]]*(-R[[i + 1, i]] + RB[[i]]))), {i, 1,
n - 1}, {j, 1, n - 1}];
K = LinearSolve[A, b];
MatrixForm[K]
Thanks for any hints!
P.S. The code should run!
You have lots of variables and lots of denominators, both of which can often make things very slow.
Let's try a simpler faster method that solves a generic form of your problem and then substitutes in all your variables and denominators.
n = 5;
MM = ...
...
A = ...
m={{m1,m2,m3,m4},{m5,m6,m7,m8},{m9,m10,m11,m12},{m13,m14,m15,m16}};
sol=Inverse[m].b/.Thread[Rule[Flatten[m],Flatten[A]]]
which gives a solution in fraction of a second. But you need to carefully check this to justify that there are no zero denominators hiding in your problem or this solution.
This method is faster than Inverse[A].b and far faster than LinearSolve[A, b] for your problem, but that time is only for the calculation of the solution and does not include any potentially large amount of time spent using the solution. It also does not include any of the programming hidden inside LinearSolve to deal with potential problems and special cases.
But I am not certain as your n grows larger and your forest of denominators grows far larger that this will continue to be fast or feasible.
Test this carefully before you assume everything works.
P.S. Thank you for the code that actually ran! (I didn't even use the clear[all])

manipulating one element in a list in mathematica

I have a list of 200 data points. I want to select one value, and change the data using the manipulate function to create a bad data point, and observe the effects on the graph.
My recent attempts included creating a variable i, and assigning like:
myarray[[80,2]] = i;
and then use manipulate as such:
Manipulate[Curve[myarray], {i, 0, 5}]
This is not giving the desired output, however. It doesn't really make sense to me to put it like that, but I don't see the alternative way. Any help on this particular problem would be greatly appreciated!
Making up some data and a Curve function :-
myarray = Transpose[{Range[10], Range[10]/2}];
Curve[myarray_] := ListLinePlot[myarray]
Manipulate[myarray[[8, 2]] = i; Curve[myarray], {i, 0, 5}]
To complement Chris Degnen's answer, which shows a good approach, here is an explanation for why your original code failed.
Manipulate, like Module, acts as a scoping construct. For this reason the i used by Manipulate (the manipulation variable) is not the same i as set with myarray[[80, 2]] = i; -- it exists in a different Context:
Manipulate[Context[i], {i, 0, 5}]
(* FE` *)
Here is a minimal example of the problem:
ClearAll[x, i]
x = i;
Manipulate[{x, i}, {i, 0, 5}]
(* {i, 2.24} *)
One way around this is to use Block, but you need to use a different name for the manipulate variable:
ClearAll[x, i]
x = {1, 2, i};
Manipulate[Block[{i = ii}, x], {ii, 0, 5}]
(* {1, 2, 1.41} *)

What is the most efficient way to construct large block matrices in Mathematica?

Inspired by Mike Bantegui's question on constructing a matrix defined as a recurrence relation, I wonder if there is any general guidance that could be given on setting up large block matrices in the least computation time. In my experience, constructing the blocks and then putting them together can be quite inefficient (thus my answer was actually slower than Mike's original code). Join and possibly ArrayFlatten are possibly less efficient than they could be.
Obviously if the matrix is sparse, one can use SparseMatrix constructs, but there will be times when the block matrix you are constructing is not sparse.
What is best practice for this kind of problem? I am assuming the elements of the matrix are numeric.
The code shown below is available here: http://pastebin.com/4PWWxGhB. Just copy and paste it into a notebook to test it out.
I was actually trying to do several functional ways of calculating matrices, since I
figured the functional way (which is typically idiomatic in Mathematica) is more efficient.
As one example, I had this matrix which was composed of two lists:
In: L = 1200;
e = Table[..., {2L}];
f = Table[..., {2L}];
h = Table[0, {2L}, {2L}];
Do[h[[i, i]] = e[[i]], {i, 1, L}];
Do[h[[i, i]] = e[[i-L]], {i, L+1, 2L}];
Do[h[[i, j]] = f[[i]]f[[j-L]], {i, 1, L}, {j, L+1, 2L}];
Do[h[[i, j]] = h[[j, i]], {i, 1, 2 L}, {j, 1, i}];
My first step was to time everything.
In: h = Table[0, {2 L}, {2 L}];
AbsoluteTiming[Do[h[[i, i]] = e[[i]], {i, 1, L}];]
AbsoluteTiming[Do[h[[i, i]] = e[[i - L]], {i, L + 1, 2 L}];]
AbsoluteTiming[
Do[h[[i, j]] = f[[i]] f[[j - L]], {i, 1, L}, {j, L + 1, 2 L}];]
AbsoluteTiming[Do[h[[i, j]] = h[[j, i]], {i, 1, 2 L}, {j, 1, i}];]
Out: {0.0020001, Null}
{0.0030002, Null}
{5.0012861, Null}
{4.0622324, Null}
DiagonalMatrix[...] was slower than the do loops, so I decided to just use Do loops on the last step. As you can see, using Outer[Times, f, f] was much faster in this case.
I then wrote the equivalent using Outer for the blocks in the upper right and bottom left of the matrix, and DiagonalMatrix for the diagonal:
AbsoluteTiming[h1 = ArrayPad[Outer[Times, f, f], {{0, L}, {L, 0}}];]
AbsoluteTiming[h1 += Transpose[h1];]
AbsoluteTiming[h1 += DiagonalMatrix[Join[e, e]];]
Out: {0.9960570, Null}
{0.3770216, Null}
{0.0160009, Null}
The DiagonalMatrix was actually slower. I could replace this with just the Do loops, but I kept it because it was cleaner looking.
The current tally is 9.06 seconds for the naive Do loop, and 1.389 seconds for my next version using Outer and DiagonalMatrix. About a 6.5 times speedup, not too bad.
Sounds a lot faster, now doesn't it? Let's try using Compile now.
In: cf = Compile[{{L, _Integer}, {e, _Real, 1}, {f, _Real, 1}},
Module[{h},
h = Table[0.0, {2 L}, {2 L}];
Do[h[[i, i]] = e[[i]], {i, 1, L}];
Do[h[[i, i]] = e[[i - L]], {i, L + 1, 2 L}];
Do[h[[i, j]] = f[[i]] f[[j - L]], {i, 1, L}, {j, L + 1, 2 L}];
Do[h[[i, j]] = h[[j, i]], {i, 1, 2 L}, {j, 1, i}];
h]];
AbsoluteTiming[cf[L, e, f];]
Out: {0.3940225, Null}
Now it's running 3.56 times faster than my last version, and 23.23 times faster than the first one. Next version:
In: cf = Compile[{{L, _Integer}, {e, _Real, 1}, {f, _Real, 1}},
Module[{h},
h = Table[0.0, {2 L}, {2 L}];
Do[h[[i, i]] = e[[i]], {i, 1, L}];
Do[h[[i, i]] = e[[i - L]], {i, L + 1, 2 L}];
Do[h[[i, j]] = f[[i]] f[[j - L]], {i, 1, L}, {j, L + 1, 2 L}];
Do[h[[i, j]] = h[[j, i]], {i, 1, 2 L}, {j, 1, i}];
h], CompilationTarget->"C", RuntimeOptions->"Speed"];
AbsoluteTiming[cf[L, e, f];]
Out: {0.1370079, Null}
Most of the speed came from CompilationTarget->"C". Here I got another 2.84 speedup over the fastest version, and 66.13 times speedup over the first version. But all I did was just compile it!
Now, this is a very simple example. But this is real code I'm using to solve a problem in condensed matter physics. So don't dismiss it as possibly being a "toy example."
How's about another example of a technique we can use? I have a relatively simple matrix I have to build up. I have a matrix that's composed of nothing but ones from the start to some arbitrary point. The naive way may look something like this:
In: k = L;
AbsoluteTiming[p = Table[If[i == j && j <= k, 1, 0], {i, 2L}, {j, 2L}];]
Out: {5.5393168, Null}
Instead, let's build it up using ArrayPad and IdentityMatrix:
In: AbsoluteTiming[ArrayPad[IdentityMatrix[k], {{0, 2L-k}, {0, 2L-k}}
Out: {0.0140008, Null}
This actually doesn't work for k = 0, but you can special case that if you need that. Furthermore, depending on the size of k, this can be faster or slower. It's always faster than the Table[...] version though.
You could even write this using SparseArray:
In: AbsoluteTiming[SparseArray[{i_, i_} /; i <= k -> 1, {2 L, 2 L}];]
Out: {0.0040002, Null}
I could go on about some other things, but I'm afraid if I do I'll make this answer unreasonably large. I've accumulated a number of techniques for forming these various matrices and lists in the time I spent trying to optimize some code. The base code I worked with took over 6 days for one calculation to run, and now it takes only 6 hours to do the same thing.
I'll see if I can pick out the general techniques I've come up with and just stick them in a notebook to use.
TL;DR: It seems like for these cases, the functional way outperforms the procedural way. But when compiled, the procedural code outperforms the functional code.
Looking at what Compile does to Do loops is instructive. Consider this:
L=1200;
Do[.7, {i, 1, 2 L}, {j, 1, i}] // Timing
Do[.3 + .4, {i, 1, 2 L}, {j, 1, i}] // Timing
Do[.3 + .4 + .5, {i, 1, 2 L}, {j, 1, i}] // Timing
Do[.3 + .4 + .5 + .8, {i, 1, 2 L}, {j, 1, i}] // Timing
(*
{0.390163, Null}
{1.04115, Null}
{1.95333, Null}
{2.42332, Null}
*)
First, it seems safe to assume that Do does not automatically compile its argument if it's over some length (as Map, Nest etc do): you can keep adding constants and the derivative of time taken vs number of constants is constant. This is further supported by the nonexistence of such an option in SystemOptions["CompileOptions"].
Next, since this loops around n(n-1)/2 times with n=2*L, so around 3*10^6 times for our L=1200, the time taken for each addition indicates that there is a lot more going on than is necessary.
Next let us try
Compile[{{L,_Integer}},Do[.7,{i,1,2 L},{j,1,i}]]#1200//Timing
Compile[{{L,_Integer}},Do[.7+.7,{i,1,2 L},{j,1,i}]]#1200//Timing
Compile[{{L,_Integer}},Do[.7+.7+.7+.7,{i,1,2 L},{j,1,i}]]#1200//Timing
(*
{0.032081, Null}
{0.032857, Null}
{0.032254, Null}
*)
So here things are more reasonable. Let's take a look:
Needs["CompiledFunctionTools`"]
f1 = Compile[{{L, _Integer}},
Do[.7 + .7 + .7 + .7, {i, 1, 2 L}, {j, 1, i}]];
f2 = Compile[{{L, _Integer}}, Do[2.8, {i, 1, 2 L}, {j, 1, i}]];
CompilePrint[f1]
CompilePrint[f2]
the two CompilePrints give the same output, namely,
1 argument
9 Integer registers
Underflow checking off
Overflow checking off
Integer overflow checking on
RuntimeAttributes -> {}
I0 = A1
I5 = 0
I2 = 2
I1 = 1
Result = V255
1 I4 = I2 * I0
2 I6 = I5
3 goto 8
4 I7 = I6
5 I8 = I5
6 goto 7
7 if[ ++ I8 < I7] goto 7
8 if[ ++ I6 < I4] goto 4
9 Return
f1==f2 returns True.
Now, do
f5 = Compile[{{L, _Integer}}, Block[{t = 0.},
Do[t = Sin[i*j], {i, 1, 2 L}, {j, 1, i}]; t]];
f6 = Compile[{{L, _Integer}}, Block[{t = 0.},
Do[t = Sin[.45], {i, 1, 2 L}, {j, 1, i}]; t]];
CompilePrint[f5]
CompilePrint[f6]
I won't show the full listings, but in the first there is a line R3 = Sin[ R1] while in the second there is an assignment to a register R1 = 0.43496553411123023 (which, however, is reassigned in the innermost part of the loop by R2 = R1; perhaps if we output to C this will be optimized by gcc eventually).
So, in these very simple cases, uncompiled Do just blindly executes the body without inspecting it, while Compile does do various simple optimizations (in addition to outputing byte code). While here I am choosing examples that exaggerate how literally Do interprets its argument, this kind of thing partly explains the large speedup after compiling.
As for the huge speedup in Mike Bantegui's question yesterday, I think the speedup in such simple problems (just looping and multiplying things) is because there is no reason that automatically produced C code can't be optimized by the compiler to get things running as fast as possible. The C code produced is too hard to understand for me, but the bytecode is readable and I don't think that there is anything all that wasteful. So it is not that shocking that it is so fast when compiled to C. Using built-in functions shouldn't be any faster than that, since there shouldn't be any difference in the algorithm (if there is, the Do loop shouldn't have been written that way).
All this should be checked case by case, of course. In my experience, Do loops usually are the fastest way to go for this kind of operation. However, compilation has its limits: if you are producing large objects and trying to pass them around between two compiled functions (as arguments), the bottleneck can be this transfer. One solution is to simply put everything into one giant function and compile that; this ends up being harder and harder to do (you are forced to write C in mma, so to speak). Or you can try compiling the individual functions and using CompilationOptions -> {"InlineCompiledFunctions" -> True}] in the Compile. Things can get tricky very fast, though.
But this is getting too long.

Generate a list in Mathematica with a conditional tested for each element

Suppose we want to generate a list of primes p for which p + 2 is also prime.
A quick solution is to generate a complete list of the first n primes and use the Select function to return the elements which meet the condition.
Select[Table[Prime[k], {k, n}], PrimeQ[# + 2] &]
However, this is inefficient as it loads a large list into the memory before returning the filtered list. A For loop with Sow/Reap (or l = {}; AppendTo[l, k]) solves the memory issue, but it is far from elegant and is cumbersome to implement a number of times in a Mathematica script.
Reap[
For[k = 1, k <= n, k++,
p = Prime[k];
If[PrimeQ[p + 2], Sow[p]]
]
][[-1, 1]]
An ideal solution would be a built-in function which allows an option similar to this.
Table[Prime[k], {k, n}, AddIf -> PrimeQ[# + 2] &]
I will interpret this more as a question about automation and software engineering rather than about the specific problem at hand, and given a large number of solutions posted already. Reap and Sow are good means (possibly, the best in the symbolic setting) to collect intermediate results. Let us just make it general, to avoid code duplication.
What we need is to write a higher-order function. I will not do anything radically new, but will simply package your solution to make it more generally applicable:
Clear[tableGen];
tableGen[f_, iter : {i_Symbol, __}, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[#,sowTag]] &[f[i]], iter],sowTag]];
The advantages of using Do over For are that the loop variable is localized dynamically (so, no global modifications for it outside the scope of Do), and also the iterator syntax of Do is closer to that of Table (Do is also slightly faster).
Now, here is the usage
In[56]:= tableGen[Prime, {i, 10}, PrimeQ[# + 2] &]
Out[56]= {3, 5, 11, 17, 29}
In[57]:= tableGen[Prime, {i, 3, 10}, PrimeQ[# + 1] &]
Out[57]= {}
In[58]:= tableGen[Prime, {i, 10}]
Out[58]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
EDIT
This version is closer to the syntax you mentioned (it takes an expression rather than a function):
ClearAll[tableGenAlt];
SetAttributes[tableGenAlt, HoldAll];
tableGenAlt[expr_, iter_List, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[#,sowTag]] &[expr], iter],sowTag]];
It has an added advantage that you may even have iterator symbols defined globally, since they are passed unevaluated and dynamically localized. Examples of use:
In[65]:= tableGenAlt[Prime[i], {i, 10}, PrimeQ[# + 2] &]
Out[65]= {3, 5, 11, 17, 29}
In[68]:= tableGenAlt[Prime[i], {i, 10}]
Out[68]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
Note that since the syntax is different now, we had to use the Hold-attribute to prevent the passed expression expr from premature evaluation.
EDIT 2
Per #Simon's request, here is the generalization for many dimensions:
ClearAll[tableGenAltMD];
SetAttributes[tableGenAltMD, HoldAll];
tableGenAltMD[expr_, iter__List, addif : Except[_List] : (True &)] :=
Module[{indices, indexedRes, sowTag},
SetDelayed ## Prepend[Thread[Map[Take[#, 1] &, List ## Hold ### Hold[iter]],
Hold], indices];
indexedRes =
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[{#, indices},sowTag]] &[expr], iter],sowTag];
Map[
First,
SplitBy[indexedRes ,
Table[With[{i = i}, Function[Slot[1][[2, i]]]], {i,Length[Hold[iter]] - 1}]],
{-3}]];
It is considerably less trivial, since I had to Sow the indices together with the added values, and then split the resulting flat list according to the indices. Here is an example of use:
{i, j, k} = {1, 2, 3};
tableGenAltMD[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}, # < 7 &]
{{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
I assigned the values to i,j,k iterator variables to illustrate that this function does localize the iterator variables and is insensitive to possible global values for them. To check the result, we may use Table and then delete the elements not satisfying the condition:
In[126]:=
DeleteCases[Table[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}],
x_Integer /; x >= 7, Infinity] //. {} :> Sequence[]
Out[126]= {{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
Note that I did not do extensive checks so the current version may contain bugs and needs some more testing.
EDIT 3 - BUG FIX
Note the important bug-fix: in all functions, I now use Sow with a custom unique tag, and Reap as well. Without this change, the functions would not work properly when expression they evaluate also uses Sow. This is a general situation with Reap-Sow, and resembles that for exceptions (Throw-Catch).
EDIT 4 - SyntaxInformation
Since this is such a potentially useful function, it is nice to make it behave more like a built-in function. First we add syntax highlighting and basic argument checking through
SyntaxInformation[tableGenAltMD] = {"ArgumentsPattern" -> {_, {_, _, _., _.}.., _.},
"LocalVariables" -> {"Table", {2, -2}}};
Then, adding a usage message allows the menu item "Make Template" (Shift+Ctrl+k) to work:
tableGenAltMD::usage = "tableGenAltMD[expr,{i,imax},addif] will generate \
a list of values expr when i runs from 1 to imax, \
only including elements if addif[expr] returns true.
The default of addiff is True&."
A more complete and formatted usage message can be found in this gist.
I think the Reap/Sow approach is likely to be most efficient in terms of memory usage. Some alternatives might be:
DeleteCases[(With[{p=Prime[#]},If[PrimeQ[p+2],p,{}] ] ) & /# Range[K]),_List]
Or (this one might need some sort of DeleteCases to eliminate Null results):
FoldList[[(With[{p=Prime[#2]},If[PrimeQ[p+2],p] ] )& ,1.,Range[2,K] ]
Both hold a big list of integers 1 to K in memory, but the Primes are scoped inside the With[] construct.
Yes, this is another answer. Another alternative that includes the flavour of the Reap/Sow approach and the FoldList approach would be to use Scan.
result = {1};
Scan[With[{p=Prime[#]},If[PrimeQ[p+2],result={result,p}]]&,Range[2,K] ];
Flatten[result]
Again, this involves a long list of integers, but the intermediate Prime results are not stored because they are in the local scope of With. Because p is a constant in the scope of the With function, you can use With rather than Module, and gain a bit of speed.
You can perhaps try something like this:
Clear[f, primesList]
f = With[{p = Prime[#]},Piecewise[{{p, PrimeQ[p + 2]}}, {}] ] &;
primesList[k_] := Union#Flatten#(f /# Range[k]);
If you want both the prime p and the prime p+2, then the solution is
Clear[f, primesList]
f = With[{p = Prime[#]},Piecewise[{{p, PrimeQ[p + 2]}}, {}] ] &;
primesList[k_] :=
Module[{primes = f /# Range[k]},
Union#Flatten#{primes, primes + 2}];
Well, someone has to allocate memory somewhere for the full table size, since it is not known before hand what the final size will be.
In the good old days before functional programming :), this sort of thing was solved by allocating the maximum array size, and then using a separate index to insert to it so no holes are made. Like this
x=Table[0,{100}]; (*allocate maximum possible*)
j=0;
Table[ If[PrimeQ[k+2], x[[++j]]=k],{k,100}];
x[[1;;j]] (*the result is here *)
{1,3,5,9,11,15,17,21,27,29,35,39,41,45,51,57,59,65,69,71,77,81,87,95,99}
Here's another couple of alternatives using NextPrime:
pairs1[pmax_] := Select[Range[pmax], PrimeQ[#] && NextPrime[#] == 2 + # &]
pairs2[pnum_] := Module[{p}, NestList[(p = NextPrime[#];
While[p + 2 != (p = NextPrime[p])];
p - 2) &, 3, pnum]]
and a modification of your Reap/Sow solution that lets you specify the maximum prime:
pairs3[pmax_] := Module[{k,p},
Reap[For[k = 1, (p = Prime[k]) <= pmax, k++,
If[PrimeQ[p + 2], Sow[p]]]][[-1, 1]]]
The above are in order of increasing speed.
In[4]:= pairs2[10000]//Last//Timing
Out[4]= {3.48,1261079}
In[5]:= pairs1[1261079]//Last//Timing
Out[5]= {6.84,1261079}
In[6]:= pairs3[1261079]//Last//Timing
Out[7]= {0.58,1261079}

automatize a mathematic procedure: I need industrial amouts of results, and I get one

I've the following simple code in mathematica that is what I want to a single output. But I want to get hundreds or thousands of it. How can I do?
Clear["Global`*"]
k = 2; Put["phiout"]; Put["omegadiffout"];
Random[NormalDistribution[0, 0.1]];
For[i = 1, i < 31,
rnd[i] = Random[NormalDistribution[0, 0.1]]; i++]
Table[rnd[i], {i, 1, 30}]
For[i = 1, i < 30,
rnddf[i] = rnd[i + 1] - rnd[i]; i++
]
diffomega = Table [rnddf[i], {i, 1, 29}];
Table[
Table [rnddf[i], {i, 1, 29}], {j, 1, 100}];
PutAppend[Table[
diffomega, {j, 1, 100}] , "diffomega"]
eqs0 = Table [
k*phi[i + 1] + k*phi[i - 1] - 2*k*phi[i] - rnddf[i] == 0, {i, 1,
28}];
eqs1 = eqs0 /. {phi[0] -> phi[30], phi[31] -> phi[1]};
Sum[phi[i], {i, 1, 29}];
eqs2 = Append[eqs1, - phi[1] - phi[27] - 3 phi[29] == 0];
eqs3 = eqs2 /. {phi[30] -> -Sum[phi[i], {i, 1, 29}]};
vars = Table [phi[i], {i, 1, 29}];
eqs = NSolve[eqs3, vars];
PutAppend[diffomega, eqs , "phiout"]
This put on file "phiout" and "omegadiffout" only the last value. I need hundreds of them. For each random generations I need an output.
Thanks in advance
The first thing you need to do, #Paulo, is tidy up your Mathematica so that you, and we, can see the wood for the trees. For example, your 8th statement:
Table[
Table [rnddf[i], {i, 1, 29}], {j, 1, 100}];
makes a large table, but the table isn't assigned to a variable or used in any other way. There seem to be other statements whose results aren't used either.
Next you should abandon your For loops and use the Mathematica idioms -- they are clearer for we who use Mathematica regularly to understand, easier for you to write, and probably more efficient too. Your statements
For[i = 1, i < 31,
rnd[i] = Random[NormalDistribution[0, 0.1]]; i++]
Table[rnd[i], {i, 1, 30}]
For[i = 1, i < 30,
rnddf[i] = rnd[i + 1] - rnd[i]; i++
]
diffomega = Table [rnddf[i], {i, 1, 29}];
can, if I understand correctly, be replaced by:
diffomega = Differences[RandomReal[NormalDistribution[0,0.1],{30}]];
Always remember that if you are writing loops in Mathematica you are probably making a mistake. The next change you should make is to stop using Put and PutAppend until you can build, in memory, at least a small example of the entire output that you want to write. Then write that to a file in one go with Save or Export or one of the other high-level I/O functions.
When you have done that, edit your code and explain what you are trying to do and I, and other SOers, will try to help further. Unfortunately, right now, your code is so un-Mathematica-al that I'm having trouble figuring it out.

Resources