Related
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}
I have earlier asked how to make allTrue[{x,list},test] function that protects the placeholder symbol x from evaluation in current context in the same way as Table[expr,{x,...}] protects x
The recipe that I ended up using failed intermittently, and I found the problem down to be caused by automatic conversion of lists to PackedArrays. Here's a failing example
SetAttributes[allTrue, HoldAll];
allTrue[{var_, lis_}, expr_] :=
LengthWhile[lis,
TrueQ[ReleaseHold[Hold[expr] /. HoldPattern[var] -> #]] &] ==
Length[lis];
allTrue[{y, Developer`ToPackedArray[{1, 1, 1}]}, y > 0]
I want allTrue[{x,{1,2,3}},x>0] to return True regardless of whether {1,2,3} gets automatically converted into PackedArray, what is a better way to implement it?
This is a version I've been using for quite a while (wrote it for a second edition of my book originally, but I ended up using it a lot). If arguments represent some unevaluated code, then the test function must have HoldAll or HoldFirst attributes if we want a single piece of code representing one specific clause to be passed to it in its unevaluated form (which may or may not be desirable).
ClearAll[fastOr];
Attributes[fastOr] = {HoldRest};
fastOr[test_, {args___}] := fastOr[test, args];
fastOr[test_, args___] :=
TrueQ[Scan[
Function[arg, If[test[arg], Return[True]], HoldAll],
Hold[args]]];
Edit: I just noticed that the solution by Daniel Reeves at the bottom of the page linked in the question, is very similar to this one. The main difference is that I care about both short-circuiting and keeping arguments unevaluated (see below), while Daniel focuses on the short-circuiting part only.
It does have a short-circuiting behavior. We need HoldRest attribute since we want to preserve the arguments in their unevaluated form. We also need the HoldAll (or HoldFirst) attribute in a pure function to preserve each of the arguments unevaluated until it is passed to test. Whether or not it gets evaluated before it is used in the body of test depends now on the attributes of test. As an example:
Clear[fullSquareQ];
fullSquareQ[x_Integer] := IntegerQ[Sqrt[x]];
In[13]:= Or ## Map[fullSquareQ, Range[50000]] // Timing
Out[13]= {0.594, True}
In[14]:= fastOr[fullSquareQ, Evaluate[Range[10000]]] // Timing
Out[14]= {0., True}
Here is an example where we pass as arguments some pieces of code inducing side effects (printing). The code of the last argument has no chance to execute, since the result has already been determined at the previous clause:
In[15]:= fastOr[# &, Print["*"]; False, Print["**"]; False,
Print["***"]; True, Print["****"]; False]
During evaluation of In[15]:= *
During evaluation of In[15]:= **
During evaluation of In[15]:= ***
Out[15]= True
Note that, since fastOr accepts general pieces of unevaluated code as clauses for Or, you have to wrap your list of values in Evaluate if you don't care that they are going to be evaluated at the start ( as is the case with the Range example above).
Finally, I will illustrate the programmatic construction of held code for fastOr, to show how it can be used (consider it a tiny crash course on working with held expressions if you wish). The following function is very useful when working with held expressions:
joinHeld[a___Hold] := Hold ## Replace[Hold[a], Hold[x___] :> Sequence[x], {1}];
Example:
In[26]:= joinHeld[Hold[Print[1]], Hold[Print[2], Print[3]], Hold[], Hold[Print[4]]]
Out[26]= Hold[Print[1], Print[2], Print[3], Print[4]]
Here is how we use it to construct programmatically the held arguments that were used in the example with Print-s above:
In[27]:=
held = joinHeld ## MapThread[Hold[Print[#]; #2] &,
{NestList[# <> "*" &, "*", 3], {False, False, True, False}}]
Out[27]= Hold[Print["*"]; False, Print["**"]; False, Print["***"]; True, Print["****"]; False]
To pass it to fastOr, we will use another useful idiom: append (or prepend) to Hold[args] until we get all function arguments, and then use Apply (note that, in general, if we don't want the piece we are appending / prepending to evaluate, we must wrap it in Unevaluated, so the general idiom looks like Append[Hold[parts___],Unevaluated[newpart]]):
In[28]:= fastOr ## Prepend[held, # &]
During evaluation of In[28]:= *
During evaluation of In[28]:= **
During evaluation of In[28]:= ***
Out[28]= True
Regarding the original implementation you refer to, you can look at my comment to it I made some while ago. The problem is that TakeWhile and LengthWhile have bugs for packed arrays in v. 8.0.0, they are fixed in the sources of 8.0.1 - so, starting from 8.0.1, you can use either mine or Michael's version.
HTH
Edit:
I just noticed that in the post you referred to, you wanted a different syntax. While it would not be very difficult to adopt the approach taken in fastOr to this case, here is a different implementation, which arguably is in closer correspondence with the existing language constructs for this particular syntax. I suggest to use Table and exceptions, since iterators in Table accept the same syntax as you want. Here it is:
ClearAll[AnyTrue, AllTrue];
SetAttributes[{AnyTrue, AllTrue}, HoldAll];
Module[{exany, exall},
AnyTrue[iter : {var_Symbol, lis_List}, expr_] :=
TrueQ[Catch[Table[If[TrueQ[expr], Throw[True, exany]], iter], exany]];
AllTrue[iter : {var_Symbol, lis_List}, expr_] :=
Catch[Table[If[! TrueQ[expr], Throw[False, exall]], iter], exall] =!= False;
];
A few words of explanation: I use Module on the top level since the custom exception tags we need to define just once, can as well do that at definition-time. The way to break out of Table is through exceptions. Not very elegant and induces a small performance hit, but we buy automatic dynamic localization of your iterator variables done by Table, and simplicity. To do this in a safe way, we must tag an exception with a unique tag, so we don't catch some other exception by mistake. I find using Module for creating persistent exception tags to be a very useful trick in general. Now, some examples:
In[40]:= i = 1
Out[40]= 1
In[41]:= AnyTrue[{i, {1, 2, 3, 4, 5}}, i > 3]
Out[41]= True
In[42]:= AnyTrue[{i, {1, 2, 3, 4, 5}}, i > 6]
Out[42]= False
In[43]:= AllTrue[{i, {1, 2, 3, 4, 5}}, i > 3]
Out[43]= False
In[44]:= AllTrue[{i, {1, 2, 3, 4, 5}}, i < 6]
Out[44]= True
In[45]:= AllTrue[{a, {1, 3, 5}}, AnyTrue[{b, {2, 4, 5}}, EvenQ[a + b]]]
Out[45]= True
In[46]:= AnyTrue[{a, {1, 3, 5}}, AllTrue[{b, {2, 4, 5}}, EvenQ[a + b]]]
Out[46]= False
I started with an assignment to i to show that possible global values of iterator variables don't matter - this is taken care of by Table. Finally, note that (as I commented elsewhere), your original signatures for AllTrue and AnyTrue are a bit too restrictive, in the sense that the following does not work:
In[47]:= lst = Range[5];
AllTrue[{i, lst}, i > 3]
Out[48]= AllTrue[{i, lst}, i > 3]
(since the fact that lst represents a list is not known at the pattern-matching time, due to HoldAll attribute). There is no good reason to keep this behavior, so you can just remove the _List checks: AnyTrue[iter : {var_Symbol, lis_}, expr_] and similarly for AllTrue, and this class of use cases will be covered.
I have a highly irregular nested list myList in mma, whenever I am given a integer sequence, such as 1,1,2,3,1 of any length, I want to know if
myList[[1,1,2,3,1]]
is valid; because if it is not, then I will get an error saying
Part::partw: part... does not exist
Thanks.
Quiet[
Check[mylist[[1, 1, 2, 3, 1]], Print[False], Part::partd],
Part::partd];
You can replace Print[False] for any other action ...
Edit
To check for both partd and partw messages the syntax is:
Quiet[Check[{{{1, 3}}, {2}}[[1, 4, 2, 3, 1]],
Print[False], {Part::partd, Part::partw}],
{Part::partd, Part::partw}];
HTH!
Coincidently this came up on MathGroup a few weeks ago. Below is a URL to what I believe was the last and best response (from Ray Koopman).
http://forums.wolfram.com/mathgroup/archive/2011/Jan/msg00326.html
It also has links to earlier posts in the same thread.
Daniel Lichtblau
Wolfram Research
Here is another way of doing it.
Quiet[MemberQ[#, #[[1, 4, 2, 3, 1]], Infinity] &[{{{1, 3}}, {2}}]]
Returns False.
It will essentially return true or false after checking to see whether the element at that position (if it exists) is in the list.
Quiet[MemberQ[#, #[[1, 1, 2]], Infinity] &[{{{1, 3}}, {2}}]]
Returns True.
belisarius's answer will give more low level control though.
How to get the oddly indexed elements in a list? I am thinking of Select, but did not find anything returning an element's position, especially considering there are repetitive elements in the list.
Also in general, how to select those elements whose indices satisfy some certain conditions?
Here's a few more in addition to #belisarius's answer, which don't require computing Length[lis]:
Take[lis, {1, -1, 2}]
lis[[1 ;; -1 ;; 2]]
You can often use -1 to represent the "last" position.
There are a lot of ways, here are some of them:
In[2]:= a = Range[10];le = Length#a;
In[3]:= Table[a[[i]], {i, 1, le, 2}]
In[5]:= Pick[a, Table[Mod[i, 2], {i, 1, le}], 1]
In[6]:= a[[1 ;; le ;; 2]]
In general, with Pick[] (as an example) you can model any conceivable index mask.
For some reason the terse form of Span has been omitted from the answers.
Range[20][[;;;;2]]
{1, 3, 5, 7, 9, 11, 13, 15, 17, 19}
Quoting the documentation:
;;;;k
from the beginning to the end in steps of k.
Hi I am using Mathematica 5.2. Suppose I have an array list like
In[2]:=lst=Tuples[{0,1},4]
Out[2]={{0,0,0,0},{0,0,0,1},{0,0,1,0},{0,0,1,1},
{0,1,0,0},{0,1,0,1},{0,1,1,0},{0,1,1,1},
{1,0,0,0},{1,0,0,1},{1,0,1,0},{1,0,1,1},
{1,1,0,0},{1,1,0,1},{1,1,1,0},{1,1,1,1}}
Now I want to get 16 arrays from the above array like st1={0,0,0,0}; st2={0,0,0,1}, st3={0,0,1,0}...
How can I get these array lists using a loop. Because if the no. of elements of the above array named lst become larger then it will not be a wise decision to take each of the element of the array lst separately and give their name separately. I tried this like the following way but it is not working...
Do[st[i]=lst[[i]],{i,1,16}]
Plz some body help me in this problem...
It does work, but what you create are the so-called indexed variables. You should access them also using the index, for example:
In[4]:= {st[1], st[2], st[3]}
Out[4]= {{0, 0, 0}, {0, 0, 1}, {0, 1, 0}}
I think what you are trying to do could be done by:
lst = Tuples[{0, 1}, 4];
Table[Evaluate[Symbol["lst" <> ToString[i]]] = lst[[i]], {i, Length#lst}]
So that
lst1 == {0,0,0,0}
But this is not a useful way to manage vars in Mathematica.
Edit
I'll try to show you why having vars lst1,lst2 .. is not useful, and is against the "Mathematica way".
Mathematica works better by applying functions to objects. For example, suppose you want to work with EuclideanDistance. You have a point {1,2,3,4} in R4, and you want to calculate the nearest point from your set to this point.
This is easily done by
eds = EuclideanDistance[{1, 2, 3, 4}, #] & /# Tuples[{0, 1}, 4]
And the nearest point distance is simply:
min = Min[eds]
If you want to know which point/s are the nearest ones, you can do:
Select[lst, EuclideanDistance[{1, 2, 3, 4}, #] == min &]
Now, try to do that same things with your intended lst1,lst2 .. asignments, and you will find it, although not impossible, very,very convoluted.
Edit
BTW, once you have
lst = Tuples[{0, 1}, 4];
You can access each element of the list just by typing
lst[[1]]
etc. In case you need to loop. But again, loops are NOT the Mathematica way. For example, if you want to get another list, with your elements normalized, don't loop and just do:
lstNorm = Norm /# lst
Which is cleaner and quicker than
Do[st[i] = Norm#lst[[i]], {i, 1, 16}]
You will find that defining downvalues (like st[i]) above) is useful when solving equations, but besides that many operations that in other languages are done using arrays, in Mathematica are better carried out by using lists.
Edit
Answering your comment actually I need each element of array lst to find the value of function such as f[x,y,z,k]=x-y+z+k. Such function may be
(#1 - #2 + #3 + #4) & ### lst
or
(#[[1]] - #[[2]] + #[[3]] + #[[4]]) & /# lst
Out:
{0, 1, 1, 2, -1, 0, 0, 1, 1, 2, 2, 3, 0, 1, 1, 2}
HTH!
You can do this:
Table[
Evaluate[
Symbol["st" <> ToString#i]] = lst[[i]],
{i, 1, Length#lst}];
at the end of which try Names["st*"] to see that you now have st1 to st16 defined. You could also do this with MapIndexed, like so:
MapIndexed[(Evaluate#Symbol["sts" <> ToString~Apply~#2] = #1) &, lst]
after which Names["sts*"] shows again that it has worked. Both of these can be done using a loop if this is what you (but I do not see what it buys you).
On the other hand, this way, when you want to access one of them, you need to do something like Symbol["sts" <> ToString[4]]. Using what you have already done or something equivalent, eg,
Table[
Evaluate[stg[i]] = lst[[i]],{i, 1, Length#lst}]
you end up with stg[1], stg[2] etc, and you can access them much more easily by eg Table[stg[i],{i,1,Length#lst}]
You can see what has been defined by ?stg or in more detail by DownValues[stg].
Or is it something else you want?
Leonid linked to a tutorial, which I suggest you read, by the way.
There are N ways of doing this, though like belisarius I have my doubts about your approach. Nonetheless, the easiest way I've found to manage things like this is to use what Mathematica calls "pure functions", like so:
In[1]:= lst = Tuples[{0,1}, 4];
In[2]:= With[{setter = (st[#1] = #2) &},
Do[setter[i, lst[[i]]], {i, Length#lst}]];
Doing it this way, the evaluation rules for special do just what you want. However, I'd approach this without a loop at all, just using a single definition:
In[3]:= ClearAll[st] (* Clearing the existing definitions is important! *)
In[4]:= st[i_Integer] := lst[[i]]
I think if you provide more detail about what you're trying to accomplish, we'll be able to provide more useful advice.
EDIT: Leonid Shifrin comments that if you change the definition of lst after the fact, the change will also affect st. You can avoid this by using With in the way he describes:
With[{rhs = lst},
st[i_Integer] := rhs[[i]]];
I don't know which will be more useful given what you're trying to do, but it's an important point either way.
Maybe something like this?
MapThread[Set, {Array[st, Length#lst], lst}];
For example:
{st[1], st[10], st[16]}
Out[14]= {{0, 0, 0, 0}, {1, 0, 0, 1}, {1, 1, 1, 1}}