Is there a pre-canned operation that would take two lists, say
a = { 1, 2, 3 }
b = { 2, 4, 8 }
and produce, without using a for loop, a new list where corresponding elements in each pair of lists have been multiplied
{ a[1] b[1], a[2] b[2], a[3] b[3] }
I was thinking there probably exists something like Inner[Times, a, b, Plus], but returns a list instead of a sum.
a = {1, 2, 3}
b = {2, 4, 8}
Thread[Times[a, b]]
Or, since Times[] threads element-wise over lists, simply:
a b
Please note that the efficiency of the two solutions is not the same:
i = RandomInteger[ 10, {5 10^7} ];
{First[ Timing [i i]], First[ Timing[ Thread[ Times [i,i]]]]}
(*
-> {0.422, 1.235}
*)
Edit
The behavior of Times[] is due to the Listable attribute. Look at this:
SetAttributes[f,Listable];
f[{1,2,3},{3,4,5}]
(*
-> {f[1,3],f[2,4],f[3,5]}
*)
You can do this using Inner by using List as the last argument:
In[5]:= Inner[Times, a, b, List]
Out[5]= {2, 8, 24}
but as others already mentioned, Times works automatically. In general for things like Inner, it's frequently useful to test things with "dummy" functions to see what the structure is:
In[7]:= Inner[f, a, b, g]
Out[7]= g[f[1, 2], f[2, 4], f[3, 8]]
and then work backwards from that to determine what the actual functions should be to give the desired result.
In answering a physics forum question this morning, I ran into really bad performance of DifferenceRoot and RecurrenceTable compared to calculating the expressions by naively taking derivatives of an exponential generating functional. A very small amount of digging showed that DifferenceRoot and RecurrenceTable do not simplify expressions as they go.
For example, look at the following output of RecurrenceTable and how it simplifies by just Expanding the result:
In[1]:= RecurrenceTable[f[n] == a f[n - 1] + (a - 1) f[n - 2] &&
f[0] == 0 && f[1] == 1,
f, {n, 6}]
% // Expand
Out[1]= {0, 1, a, -1+a+a^2, -a+a^2+a (-1+a+a^2), 1-a-a^2+a (-1+a+a^2)+a (-a+a^2+a (-1+a+a^2))}
Out[2]= {0, 1, a, -1+a+a^2, -2 a+2 a^2+a^3, 1-2 a-2 a^2+3 a^3+a^4}
This quickly gets out of hand, as the leaf count of the 20th iteration (calculated using DifferenceRoot) shows:
dr[k_] := DifferenceRoot[Function[{f, n},
{f[n] == a f[n - 1] + (a - 1) f[n - 2], f[0] == 0, f[1] == 1}]][k]
In[2]:= dr20 = dr[20]; // Timing
dr20Exp = Expand[dr20]; // Timing
Out[2]= {0.26, Null}
Out[3]= {2.39, Null}
In[4]:= {LeafCount[dr20], LeafCount[dr20Exp]}
Out[4]= {1188383, 92}
Which can be compared to the memoized implementation
In[1]:= mem[n_] := a mem[n-1] + (a-1) mem[n-2] // Expand
mem[0] = 0; mem[1] = 1;
In[3]:= mem20 = mem[20];//Timing
LeafCount[mem20]
Out[3]= {0.48, Null}
Out[4]= 92
So my question is:
Are there any options/tricks to get DifferenceRoot and RecurrenceTable to apply a (simplifying) function as they go and thus make them useful for non-numeric work?
Edit: A Sjoerd pointed out below, I foolishly chose an example with a RSolveable closed form solution. In this question I'm primarily concerned with the behaviour of DifferenceRoot and RecurrenceTable. If it helps, imagine the the f[n-2] term is multiplied by n, so that there is no simple closed form solution.
I can't really help with your question as I haven't used those functions until now, and the docs don't give a clue. But why don't you just use RSolve here? It gives a closed form solution for each of the table's elements:
sol = f /. RSolve[f[n] == a f[n - 1] + (a - 1) f[n - 2] &&
f[0] == 0 && f[1] == 1, f, n
][[1, 1]]
sol#Range[6] // Simplify
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'd like a function AnyTrue[expr,{i,{i1,i2,...}}] which checks if expr is True for any of i1,i2... It should be as if AnyTrue was Table followed by Or##%, with the difference that it only evaluates expr until first True is found.
Short-circuiting part is optional, what I'd really like to know is the proper way to emulate Table's non-standard evaluation sequence.
Update 11/14
Here's a solution due to Michael, you can use it to chain "for all" and "there exists" checks
SetAttributes[AllTrue, HoldAll];
SetAttributes[AnyTrue, HoldAll];
AllTrue[{var_Symbol, lis_List}, expr_] :=
LengthWhile[lis,
TrueQ[ReleaseHold[Hold[expr] /. HoldPattern[var] -> #]] &] ==
Length[lis];
AnyTrue[{var_Symbol, lis_List}, expr_] :=
LengthWhile[lis,
Not[TrueQ[ReleaseHold[Hold[expr] /. HoldPattern[var] -> #]]] &] <
Length[lis];
AllTrue[{a, {1, 3, 5}}, AnyTrue[{b, {2, 4, 5}}, EvenQ[a + b]]]
AnyTrue[{a, {1, 3, 5}}, AllTrue[{b, {2, 4, 5}}, EvenQ[a + b]]]
How about this?
SetAttributes[AnyTrue, HoldAll];
AnyTrue[expr_, {var_Symbol, lis_List}] :=
LengthWhile[lis,
Not[TrueQ[ReleaseHold[Hold[expr] /. HoldPattern[var] -> #]]] &
] < Length[lis]
Includes short-circuiting via LengthWhile and keeps everything held where necessary so that things work as expected with var has a value outside the function:
In[161]:= x = 777;
In[162]:= AnyTrue[Print["x=", x]; x == 3, {x, {1, 2, 3, 4, 5}}]
During evaluation of In[162]:= x=1
During evaluation of In[162]:= x=2
During evaluation of In[162]:= x=3
Out[162]= True
The built-in Or is short-circuiting, too, for what it's worth. (but I realize building up the unevaluated terms with e.g. Table is a pain):
In[173]:= Or[Print[1];True, Print[2];False]
During evaluation of In[173]:= 1
Out[173]= True
This doesn't match your spec but I often use the following utility functions, which are similar to what you have in mind (they use pure functions instead of expressions with a specified variable) and also do short-circuiting:
some[f_, l_List] := True === (* Whether f applied to some *)
Scan[If[f[#], Return[True]]&, l]; (* element of list is True. *)
every[f_, l_List] := Null === (* Similarly, And ## f/#l *)
Scan[If[!f[#], Return[False]]&, l]; (* (but with lazy evaluation). *)
For example, Michael Pilat's example would become this:
In[1]:= some[(Print["x=", #]; # == 3)&, {1, 2, 3, 4, 5}]
During evaluation of In[1]:= x=1
During evaluation of In[1]:= x=2
During evaluation of In[1]:= x=3
Out[1]= True
Does mathematica have something like "select any" that gets any element of a list that satisfies a criterion?
If you just want to return after the first matching element, use the optional third argument to Select, which is the maximum number of results to return. So you can just do
Any[list_List, crit_, default_:"no match"] :=
With[{maybeMatch = Select[list, crit, 1]},
If[maybeMatch =!= {},
First[maybeMatch],
default]
Mathematica lacks a great way to signal failure to find an answer, since it lacks multiple return values, or the equivalent of Haskell's Maybe type. My solution is to have a user-specifiable default value, so you can make sure you pass in something that's easily distinguishable from a valid answer.
Well, the downside of Eric's answer is that it does execute OddQ on all elements of the list. My call is relatively costly, and it feels wrong to compute it too often. Also, the element of randomness is clearly unneeded, the first one is fine with me.
So, how about
SelectAny[list_List, criterion_] :=
Catch[Scan[ If[criterion[#], Throw[#, "result"]] &, list];
Throw["No such element"], "result"]
And then
SelectAny[{1, 2, 3, 4, 5}, OddQ]
returns 1.
I still wish something were built into Mathematica. Using home-brew functions kind of enlarges your program without bringing much direct benefit.
The Select function provides this built-in, via its third argument which indicates the maximum number of items to select:
In[1]:= Select[{1, 2, 3, 4, 5}, OddQ, 1]
Out[1]= {1}
When none match:
In[2]:= Select[{2, 4}, OddQ, 1]
Out[2]= {}
Edit: Oops, missed that nes1983 already stated this.
You can do it relatively easily with Scan and Return
fstp[p_, l_List] := Scan[ p## && Return## &, l ]
So
In[2]:= OddQ ~fstp~ Range[1,5]
Out[2]= 1
In[3]:= EvenQ ~fstp~ Range[1,5]
Out[3]= 2
I really wish Mathematica could have some options to make expressions evaluated lazily. In a lazy language such as Haskell, you can just define it as normal
fstp p = head . filter p
There's "Select", that gets all the elements that satisfy a condition. So
In[43]:= Select[ {1, 2, 3, 4, 5}, OddQ ]
Out[43]= {1, 3, 5}
Or do you mean that you want to randomly select a single matching element? I don't know of anything built-in, but you can define it pretty quickly:
Any[lst_, q_] :=
Select[ lst, q] // (Part[#, 1 + Random[Integer, Length[#] - 1]]) &
Which you could use the same way::
In[51]:= Any[ {1, 2, 3, 4, 5}, OddQ ]
Out[51]= 3