Related
Suppose I have two very large lists {a1, a2, …} and {b1, b2, …} where all ai and bj are large sparse arrays. For the sake of memory efficiency I store each list as one comprehensive sparse array.
Now I would like to compute some function f on all possible pairs of ai and bj where each result f[ai, bj] is a sparse array again. All these sparse arrays have the same dimensions, by the way.
While
Flatten[Outer[f, {a1, a2, ...}, {b1, b2, ...}, 1], 1]
returns the desired result (in principle) it appears to consume excessive amounts of memory. Not the least because the return value is a list of sparse arrays whereas one comprehensive sparse array turns out much more efficient in my cases of interest.
Is there an efficient alternative to the above use of Outer?
More specific example:
{SparseArray[{{1, 1, 1, 1} -> 1, {2, 2, 2, 2} -> 1}],
SparseArray[{{1, 1, 1, 2} -> 1, {2, 2, 2, 1} -> 1}],
SparseArray[{{1, 1, 2, 1} -> 1, {2, 2, 1, 2} -> 1}],
SparseArray[{{1, 1, 2, 2} -> -1, {2, 2, 1, 1} -> 1}],
SparseArray[{{1, 2, 1, 1} -> 1, {2, 1, 2, 2} -> 1}],
SparseArray[{{1, 2, 1, 2} -> 1, {2, 1, 2, 1} -> 1}],
SparseArray[{{1, 2, 2, 1} -> -1, {2, 1, 1, 2} -> 1}],
SparseArray[{{1, 2, 2, 2} -> 1, {2, 1, 1, 1} -> 1}]};
ByteCount[%]
list = SparseArray[%%]
ByteCount[%]
Flatten[Outer[Dot, list, list, 1], 1];
ByteCount[%]
list1x2 = SparseArray[%%]
ByteCount[%]
Flatten[Outer[Dot, list1x2, list, 1], 1];
ByteCount[%]
list1x3 = SparseArray[%%]
ByteCount[%]
etc. Not only are the raw intermediate results of Outer (lists of sparse arrays) extremely inefficient, Outer seems to consume way too much memory during the computation itself, too.
I will propose a solution which is rather complex but allows one to only use about twice as much memory during the computation as is needed to store the final result as a SparseArray. The price to pay for this will be a much slower execution.
The code
Sparse array construction / deconstruction API
Here is the code. First, a slightly modified (to address higher-dimensional sparse arrays) sparse array construction - deconstruction API, taken from this answer:
ClearAll[spart, getIC, getJR, getSparseData, getDefaultElement,
makeSparseArray];
HoldPattern[spart[SparseArray[s___], p_]] := {s}[[p]];
getIC[s_SparseArray] := spart[s, 4][[2, 1]];
getJR[s_SparseArray] := spart[s, 4][[2, 2]];
getSparseData[s_SparseArray] := spart[s, 4][[3]];
getDefaultElement[s_SparseArray] := spart[s, 3];
makeSparseArray[dims_List, jc_List, ir_List, data_List, defElem_: 0] :=
SparseArray ## {Automatic, dims, defElem, {1, {jc, ir}, data}};
Iterators
The following functions produce iterators. Iterators are a good way to encapsulate the iteration process.
ClearAll[makeTwoListIterator];
makeTwoListIterator[fname_Symbol, a_List, b_List] :=
With[{indices = Flatten[Outer[List, a, b, 1], 1]},
With[{len = Length[indices]},
Module[{i = 0},
ClearAll[fname];
fname[] := With[{ind = ++i}, indices[[ind]] /; ind <= len];
fname[] := Null;
fname[n_] :=
With[{ind = i + 1}, i += n;
indices[[ind ;; Min[len, ind + n - 1]]] /; ind <= len];
fname[n_] := Null;
]]];
Note that I could have implemented the above function more memory - efficiently and not use Outer in it, but for our purposes this won't be the major concern.
Here is a more specialized version, which produces interators for pairs of 2-dimensional indices.
ClearAll[make2DIndexInterator];
make2DIndexInterator[fname_Symbol, i : {iStart_, iEnd_}, j : {jStart_, jEnd_}] :=
makeTwoListIterator[fname, Range ## i, Range ## j];
make2DIndexInterator[fname_Symbol, ilen_Integer, jlen_Integer] :=
make2DIndexInterator[fname, {1, ilen}, {1, jlen}];
Here is how this works:
In[14]:=
makeTwoListIterator[next,{a,b,c},{d,e}];
next[]
next[]
next[]
Out[15]= {a,d}
Out[16]= {a,e}
Out[17]= {b,d}
We can also use this to get batch results:
In[18]:=
makeTwoListIterator[next,{a,b,c},{d,e}];
next[2]
next[2]
Out[19]= {{a,d},{a,e}}
Out[20]= {{b,d},{b,e}}
, and we will be using this second form.
SparseArray - building function
This function will build a SparseArray object iteratively, by getting chunks of data (also in SparseArray form) and gluing them together. It is basically code used in this answer, packaged into a function. It accepts the code piece used to produce the next chunk of data, wrapped in Hold (I could alternatively make it HoldAll)
Clear[accumulateSparseArray];
accumulateSparseArray[Hold[getDataChunkCode_]] :=
Module[{start, ic, jr, sparseData, dims, dataChunk},
start = getDataChunkCode;
ic = getIC[start];
jr = getJR[start];
sparseData = getSparseData[start];
dims = Dimensions[start];
While[True, dataChunk = getDataChunkCode;
If[dataChunk === {}, Break[]];
ic = Join[ic, Rest#getIC[dataChunk] + Last#ic];
jr = Join[jr, getJR[dataChunk]];
sparseData = Join[sparseData, getSparseData[dataChunk]];
dims[[1]] += First[Dimensions[dataChunk]];
];
makeSparseArray[dims, ic, jr, sparseData]];
Putting it all together
This function is the main one, putting it all together:
ClearAll[sparseArrayOuter];
sparseArrayOuter[f_, a_SparseArray, b_SparseArray, chunkSize_: 100] :=
Module[{next, wrapperF, getDataChunkCode},
make2DIndexInterator[next, Length#a, Length#b];
wrapperF[x_List, y_List] := SparseArray[f ### Transpose[{x, y}]];
getDataChunkCode :=
With[{inds = next[chunkSize]},
If[inds === Null, Return[{}]];
wrapperF[a[[#]] & /# inds[[All, 1]], b[[#]] & /# inds[[All, -1]]]
];
accumulateSparseArray[Hold[getDataChunkCode]]
];
Here, we first produce the iterator which will give us on demand portions of index pair list, used to extract the elements (also SparseArrays). Note that we will generally extract more than one pair of elements from two large input SparseArray-s at a time, to speed up the code. How many pairs we process at once is governed by the optional chunkSize parameter, which defaults to 100. We then construct the code to process these elements and put the result back into SparseArray, where we use an auxiliary function wrapperF. The use of iterators wasn't absolutely necessary (could use Reap-Sow instead, as with other answers), but allowed me to decouple the logic of iteration from the logic of generic accumulation of sparse arrays.
Benchmarks
First we prepare large sparse arrays and test our functionality:
In[49]:=
arr = {SparseArray[{{1,1,1,1}->1,{2,2,2,2}->1}],SparseArray[{{1,1,1,2}->1,{2,2,2,1}->1}],
SparseArray[{{1,1,2,1}->1,{2,2,1,2}->1}],SparseArray[{{1,1,2,2}->-1,{2,2,1,1}->1}],
SparseArray[{{1,2,1,1}->1,{2,1,2,2}->1}],SparseArray[{{1,2,1,2}->1,{2,1,2,1}->1}]};
In[50]:= list=SparseArray[arr]
Out[50]= SparseArray[<12>,{6,2,2,2,2}]
In[51]:= larger = sparseArrayOuter[Dot,list,list]
Out[51]= SparseArray[<72>,{36,2,2,2,2,2,2}]
In[52]:= (large= sparseArrayOuter[Dot,larger,larger])//Timing
Out[52]= {0.047,SparseArray[<2592>,{1296,2,2,2,2,2,2,2,2,2,2}]}
In[53]:= SparseArray[Flatten[Outer[Dot,larger,larger,1],1]]==large
Out[53]= True
In[54]:= MaxMemoryUsed[]
Out[54]= 21347336
Now we do the power tests
In[55]:= (huge= sparseArrayOuter[Dot,large,large,2000])//Timing
Out[55]= {114.344,SparseArray[<3359232>,{1679616,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2}]}
In[56]:= MaxMemoryUsed[]
Out[56]= 536941120
In[57]:= ByteCount[huge]
Out[57]= 262021120
In[58]:= (huge1 = Flatten[Outer[Dot,large,large,1],1]);//Timing
Out[58]= {8.687,Null}
In[59]:= MaxMemoryUsed[]
Out[59]= 2527281392
For this particular example, the suggested method is 5 times more memory-efficient than the direct use of Outer, but about 15 times slower. I had to tweak the chunksize parameter (default is 100, but for the above I used 2000, to get the optimal speed / memory use combination). My method only used as a peak value twice as much memory as needed to store the final result. The degree of memory-savings as compared to Outer- based method will depend on the sparse arrays in question.
If lst1 and lst2 are your lists,
Reap[
Do[Sow[f[#1[[i]], #2[[j]]]],
{i, 1, Length##1},
{j, 1, Length##2}
] &[lst1, lst2];
] // Last // Last
does the job and may be more memory-efficient. On the other hand, maybe not. Nasser is right, an explicit example would be useful.
EDIT: Using Nasser's randomly-generated arrays, and for len=200, MaxMemoryUsed[] indicates that this form needs 170MB while the Outer form in the question takes 435MB.
Using your example list data, I believe that you will find the ability to Append to a SparseArray quite helpful.
acc = SparseArray[{}, {1, 2, 2, 2, 2, 2, 2}]
Do[AppendTo[acc, i.j], {i, list}, {j, list}]
Rest[acc]
I need Rest to drop the first zero-filled tensor in the result. The second argument of the seed SparseArray must be the dimensions of each of your elements with a prefixed 1. You may need to explicitly specify a background for the seed SparseArray to optimize performance.
Is there any way to find the lowest modulus of a list of integers? I'm not sure how to say it correctly, so I'm going to clarify with an example.
I'd like to input a list (mod x) and output the "same" list, modulus y (< x). For example, the list {0, 4, 6, 10, 12, 16, 18, 22} (mod 24) is essentially the same as {0, 4} (mod 6).
Thank you for all your help.
You are looking for a set of arithmetic sequences. We'll consider your example
ee = {0, 4, 6, 10, 12, 16, 18, 22};
which has two such sequences, and an example with four of them.
ff = {0, 3, 7, 11, 17, 20, 24, 28, 34, 37, 41, 45};
In this second one we start with {0,3,7,11} and then increase by 17. So what is the general way to get from the nth term to the n+1th? If the set has k sequences (k=2 for ee and 4 for ff) then add the modulus to the n-k+1th term. What is the modulus? It is the difference between the nth and n-kth terms.
Putting this together and assuming we know k (we don't in general, but we'll get to that) we have a recurrence of the form f(n+1)=f(n-k+1) + (f(n)-f(n-k)). So we need to find a recurrence (if one exists), check that it is of the correct form, and post-process if so.
Here is code to do all this. Note that it in effect solves for k.
findArithmeticSequences[ll : {_Integer ..}] := With[
{rec = FindLinearRecurrence[ll]},
{Take[ll, Length[rec] - 1], ll[[Length[rec]]]} /;
ListQ[rec] &&
(rec === {1, 1, -1} || MatchQ[rec, {1, 0 .., 1, -1}])
]
(Afficionados of pure functions might prefer the variant below. Failure cases are handled a bit differently, for no compelling reason.)
findArithmeticSequences2[ll : {_Integer ..}] :=
If[ListQ[#] &&
(# === {1, 1, -1} || MatchQ[#, {1, 0 .., 1, -1}]), {Take[ll,
Length[#] - 1], ll[[Length[#]]]}, $Failed] &[
FindLinearRecurrence[ll]]
Tests:
In[115]:= findArithmeticSequences[ee]
Out[115]= {{0, 4}, 6}
In[116]:= findArithmeticSequences[ff]
Out[116]= {{0, 3, 7, 11}, 17}
Note that one can "almost" do such problems by polynomial factorization (if the input has no partial sequences at the end). For example, the polynomial
In[117]:= poly = Plus ## (x^ee)
Out[117]= 1 + x^4 + x^6 + x^10 + x^12 + x^16 + x^18 + x^22
factors into
(1+x^4)*(1+x^6+x^12+x^18)
which contains the needed information in a way that is easy to see. Unfortunately for this particular purpose, Factor will factor beyond this point, and obscure the information in so doing.
I keep wondering if there might be a signal processing way to go about this sort of thing, e.g. via DFTs. But I've not come up with anything.
Daniel Lichtblau
Wow, thank you Daniel for this! It works nearly the way I want it to. Your method is just a bit "too restrictive". It doesn't return anything useful if 'FindLinearRecurrence' doesn't find any recurrence. I've modified your method a bit, so it suits my needs better. I hope you don't mind. Here's my code.
findArithmeticSequences[ll_List] := Module[{rec = FindLinearRecurrence[ll]},
If[! MatchQ[rec, {1, 0 ..., 1, -1}], Return[ll],
Return[{ll[[Length[rec]]], Take[ll, Length[rec] - 1]}];
];
];
I had a feeling it'd have to involve recurrence, I just don't have enough experience with Mathematica to implement it. Thank you again for your time!
Mod is listable, and you can remove duplicate elements by DeleteDuplicates. So
DeleteDuplicates[Mod[{0, 4, 6, 10, 12, 16, 18, 22}, 6]]
(*
-> {0,4}
*)
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 this question a while back. Just wonder what is the best way (efficiency and elegance) to do this. The way I can think of is to use RandomPermutation to randomize the indices of the list, then choose the first m (of course needs to be less than the length of the list) elements from the list. But this requires the Combinatorica package.
Any better options?
Thank you.
Oh. It turns out (since version 6) that Mathematica will just do it for you: RandomSample[list, m]
As stated by Jefromi, for MMA6 and up RandomSample will do. For versions lower than 6 you can use the RandomPermutation function from the Combinatorica package (which is quite different from the MMA8 function RandomPermutation):
list[[ Take[RandomPermutation[Length[list]],m] ]]
OK, pointless as it's built in, but here is how to implement what Jefromi suggested:
ClearAll#getel;
getel[{els_, lst_}] := Module[
{pos = RandomInteger[{1, Length#lst}]},
{els~Join~{lst\[LeftDoubleBracket]pos\[RightDoubleBracket]},
Delete[lst, pos]}]
ClearAll#getN;
getN[lst_, n_] := First#Nest[getel, {{}, lst}, n]
and usage: getN[Range[10000], 3000]. A mere 4 orders of magnitude slower than the built-in function...
How about this?
s={{{3, 1}}, {{3, 2}}, {{4, 2}}, {{5, 1}}, {{5, 2}}}
i = 1;
j = 1;
rand[list_] := Drop[
list,
Flatten[
Position[list, var[i++] = {Flatten[RandomSample[list, 1]]} ]]
]
Table[var[j++], {Length[s]}]
This produces a random arrangement of s with no repeats:
{{{5, 2}}, {{3, 1}}, {{5, 1}}, {{4, 2}}, {{3, 2}}}
In Mathematica
a = FactorInteger[44420069694]
assigns
{{2, 1}, {3, 1}, {7, 1}, {11, 2}, {13, 1}, {23, 2}, {31, 1}, {41, 1}}
to a. Now instead of the factors with their exponents I would like each of those lists expanded. The above factorization would then become
{2, 3, 7, 11, 11, 13, 23, 23, 31, 41}
I wrote the following function:
b = {}; Do[Do[b = Append[b, a[[i]][[1]]], {a[[i]][[2]]}], {i, Length[a]}]
but if you ask me it looks fugly. There sure must be a neater way to do achieve this?
Yes, for example:
Flatten[Map[Table[#[[1]], {#[[2]]}] &, a]]
Yet another way in Mathematica 6 or later.
In:= Flatten[ConstantArray ### a]
Out={2, 3, 7, 11, 11, 13, 23, 23, 31, 41}
even shorter:
Join ## ConstantArray ### a
A speed comparison of methods posted
Using the these functions (in the order they were posted):
zvrba = Flatten[Map[Table[#[[1]], {#[[2]]}] &, #]] &;
dreeves = Sequence ## Table[#1, {#2}] & ### # &;
gdelfino = Flatten[# /. {p_, n_} :> Table[p, {n}]] &;
mrwizard = Join ## ConstantArray ### # &;
sasha = Function[{p, e}, Array[p &, e, 1, Sequence]] ### # &;
and assigning them the letters Z, D, G, M, S respectively, here are Timing charts of their efficiency.
First, for increasing number of lists in the input:
Second, for increasing exponent (length of repetition) in each list:
Note that these charts are logarithmic. Lower is better.
Here's another way to do it:
rptseq[x_, n_] := Sequence ## Table[x, {n}]
rptseq ### a
Which can be condensed with a lambda function to:
Sequence ## Table[#1, {#2}] & ### a
zvrba's answer can also be condensed a bit, if you're into that sort of thing:
Flatten[Table[#1, {#2}]& ### a]
(Now that I look at that, I guess my version is a very minor variant on zvrba's.)
You could also use:
a /. {p_, n_} -> Table[p, {n}] // Flatten
UPDATE 2017/10/18:
My answer above fails "in the case of two distinct prime factors" as pointed out by Cory Walker. This update fixes it:
a /. {p_Integer, n_Integer} -> Table[p, {n}] // Flatten
notice that the benchmark done by Mr Wizard was done with the original version before this update.
One can also use Array to process the answer. Here is a short code doing this:
In[11]:= PrimeFactorInteger[i_Integer] :=
Function[{p, e}, Array[p &, e, 1, Sequence]] ### FactorInteger[i]
In[12]:= PrimeFactorInteger[2^3 3^2 5]
Out[12]= {2, 2, 2, 3, 3, 5}