Related
My aim is to create a lot of functions f_i in a loop. These functions depend on parameters a[[i]], which can be taken from array A = {a1, a2, ...}. In order to eliminate the influence of the interator i, which leads to the situation when all functions are the same, I aspire to create variable names for each iteration.
The example: suppose I have got the array W = {1,2,3, ..., 100} and I should create variables w1 = 1, w2 = 2, ..., w100 = 100. I am trying to do this with the help of a for-loop:
loc[expr1_, expr2_] :=
ToExpression[StringJoin[ToString[expr1], ToString[expr2]]];
For[i = 1, i <= 100, i++,
{
loc[w, i] = W[[i]];
}]
When I need to see which value variable wk contains, then wk is not defined. But loc[w, k] = k is known.
How can I define variables wi? Or is there another way to create functions in a loop?
Thanks in advance
The way you are using {} leads me to believe that you have prior experience with other programming languages.
Mathematica is a very different language and some of what you know and expect will be wrong. Mathematica only uses {} to mean that is a list of elements. It is not used to group blocks of code. ; is more often used to group blocks of code.
Next, try
W={1,2,3};
For[i=i,i<=3,i++,
ToExpression["w"<>ToString[i]<>"="<>ToString[i]]
];
w2
and see that that returns
2
I understand that there is an intense desire in people who have been trained in other programming languages to use For to accomplish things. There are other ways o doing that for most purposes in Mathematica.
For one simple example
W={1,2,3};
Map[ToExpression["z"<>ToString[#]<>"="<>ToString[#]]&,W];
z2
returns
2
where I used z instead of w just to be certain that it wasn't showing me a prior cached value of w2
You can even do things like
W={1,2,3};
loc[n_,v_]:=ToExpression[ToString[n]<>ToString[v]<>"="<>ToString[v]];
Map[loc[a,#]&,W];
a3
which returns
3
Ordinarily, you will use indexed variables for this. E.g.,
ClearAll[x, xs]
n = 4
xs = Array[Indexed[x, #] &, 4]
Example use with random data:
RandomSeed[314]
mA = RandomInteger[{0, 99}, {n, n}]
vb = RandomInteger[{0, 99}, n]
Solve[mA.xs == vb, xs]
This is just for illustration; one would ordinarily use LinearSolve for the example problem. E.g., MapThread[Rule, {xs, LinearSolve[mA, vb]}].
It would be simpler to use a function variable, e.g. w[1], but here is a method to define w1 etc.
Note Clear can clear assignments using string versions of the symbols.
W = {1, 2, 7, 9};
Clear ## Map["w" <> ToString[#] &, W]
Map[(Evaluate[Symbol["w" <> ToString[#]]] = #) &, W];
w9
9
Symbol /# Map["w" <> ToString[#] &, W]
{1, 2, 7, 9}
Alternatively, with a function variable . . .
Map[(w[#] = #) &, W]
{1, 2, 7, 9}
w[9]
9
Also, using the OP's structure
Clear[loc]
Clear[w]
Clear ## Map["w" <> ToString[#] &, W]
W = {1, 2, 3, 4};
loc[expr1_, expr2_] := StringJoin[ToString[expr1], ToString[expr2]]
For[i = 1, i <= 4, i++, Evaluate[Symbol[loc[w, i]]] = W[[i]]]
Symbol /# Map["w" <> ToString[#] &, W]
{1, 2, 3, 4}
Note Evaluate[Symbol[loc[w, i]]] = W[[i]]] has the advantage that if the data at W[[i]] is a string it does not get transformed as it would by using ToExpression.
I need to evaluate a sum over Cartesian product of variable number of sets. Assuming f[...] is a multivariate function, define
p[A__set] := Module[{Alist, args, iterators,it},
Alist = {A};
i = 1;
iterators = {it[i++], Level[#1, 1]} & /# Alist;
args = Table[it[i], {i, Range[Length[Alist]]}];
Sum[f## args, Sequence ## iterators ]
]
But then
p[set[1, 2, 3], set[11, 12, 13]]
Gives the error:
Sum::vloc: "The variable Sequence##iterators cannot be localized so that it can be assigned to numerical values."
The following hack works:
p[A__set] := Module[{Alist, args, iterators,it,TmpSymbol},
Alist = {A};
i = 1;
iterators = {it[i++], Level[#1, 1]} & /# Alist;
args = Table[it[i], {i, Range[Length[Alist]]}];
Sum##TmpSymbol[f ## args, Sequence ## iterators ]
]
Then
p[set[1, 2, 3], set[11, 12]]
gives what I want:
f[1, 11] + f[1, 12] + f[2, 11] + f[2, 12] + f[3, 11] + f[3, 12]
I would like to know why the original does not.
As per belisarius there is much more elegant way to do this:
p[A__set] := Total[Outer[f, A],Length[{A}]];
This has to do with evaluation order. Please see Tutorial: Evaluation as a reference.
Sum has the Attribute HoldAll:
Attributes[Sum]
{HoldAll, Protected, ReadProtected}
Because of this only arguments with certain heads such as Evaluate or Sequence or Symbols with upvalues will evaluate. You may think that your argument Sequence ## iterators has the head Sequence, but it actually has the head Apply:
HoldForm # FullForm[Sequence ## iterators]
Apply[Sequence, iterators]
Sum expects literal arguments that match its declared syntax, and thus your code fails. You can force evaluation in several different ways. Arguably the most transparent is to add Evaluate:
iterators = {{a, 1, 3}, {b, 5, 7}};
Sum[a^2/b, Evaluate[Sequence ## iterators]]
107/15
More concisely you can leverage Function, SlotSequence, and Apply; evaluation takes place since neither Apply, nor Function by default, has HoldAll:
Sum[a^2/b, ##] & ## iterators
107/15
Both of these have a potential problem however: if a or b received a global value the Symbol in the definition of iterators will evaluate to this value causing another error:
a = 0;
Sum[a^2/b, ##] & ## iterators
Sum::itraw: Raw object 0 cannot be used as an iterator. >>
Instead you can store the iterator lists in a Hold expression and use the "injector pattern" to insert these values without complete evaluation:
iterators = Hold[{a, 1, 3}, {b, 5, 7}];
iterators /. _[x__] :> Sum[a^2/b, x]
107/15
Alternatively you could define iterators as an upvalue:
Sum[args___, iterators] ^:= Sum[args, {a, 1, 3}, {b, 5, 7}]
Now simply:
Sum[a^2/b, iterators]
107/15
Please see my answers to Keep function range as a variable on Mathematica.SE for more examples, as this question is closely related. Specifically see setSpec in my second answer which automates the upvalue creation.
There are many easier ways do that in Mathematica:
Total[Outer[f, {1, 2, 3}, {11, 12}, {a, b}],3]
(*
f[1, 11, a] + f[1, 11, b] + f[1, 12, a] + f[1, 12, b] +
f[2, 11, a] + f[2, 11, b] + f[2, 12, a] + f[2, 12, b] +
f[3, 11, a] + f[3, 11, b] + f[3, 12, a] + f[3, 12, b]
*)
I would like your help on something,
I have a Table:
InitialMatrix[x_, y_, age_, disease_] :=
ReplacePart[Table[Floor[Divide[dogpopulation/cellsno,9]], {x}, {y}, {age}, {disease}],
{{_, _, 1, _} -> 0, {_, _, 3, _} -> 6}];
I was trying to set up a condition to change all the values inside the table to sumthing else, according to a value, I tried:
listInitial={};
For[a = 1, a < 4, a++,
For[b = 1, b < 4, b++,
For[x = 1, x < 4, x = x + 1,
For[z = 1, z < 4, z = z + 1,
listInitial =
If[Random[] > psurvival,
ReplacePart[ InitialMatrix[3, 3, 3, 3], {a, b, x, z} ->
InitialMatrix[3, 3, 3, 3][[a]][[b]][[x]][[z]] - 1],
InitialMatrix[3, 3, 3, 3], {a, b, x, z} ->
InitialMatrix[3, 3, 3, 3][[a]][[b]][[x]][[z]]]]]]]
but it only changes the last part of my table, finally I decided to use the following code instead of the for loop,
SetAttributes[myFunction, Listable]
myFunction[x_] :=
If[Random[] > psurvival, If [x - 1 < 0 , x , x - 1], x]
myFunction[InitialMatrix[3, 3, 3, 3]] // TableForm
but now I want to change specific parts inside the table, for example I want all the part
{__,__,3,_} to change I tried to choose the range with MapAt but again I think I need to do a loop, and I cannot, can any one please help me?
For[x = 1, x < 4, x++,
listab[MapAt[f, InitialMatrix[3, 3, 3, 3], {x, 3, 3}]//TableForm]]
If you check out the documentation for MapAt, you will see that you can address multiple elements at various depths of your tensor, using various settings of the third argument. Note also the use of Flatten's second argument. I think this is what you are looking for.
MapAt[g, InitialMatrix[3, 3, 3, 3],
Flatten[Table[{i, j, 3, k}, {i, 3}, {j, 3}, {k, 3}], 2]]
http://reference.wolfram.com/mathematica/ref/MapAt.html
http://reference.wolfram.com/mathematica/ref/Flatten.html
Since this seems to be your second attempt to ask a question involving a really complicated For loop, may I just emphasise that you almost never need a For or Do loop in Mathematica in the circumstances where you would use one in, say, Fortran or C. Certainly not for most construction of lists. Table works. So do things like Listable functions (which I know you know) and commands like NestList, FoldList and Array.
You will probably also find this tutorial useful.
http://reference.wolfram.com/mathematica/tutorial/SelectingPartsOfExpressionsWithFunctions.html
I used the following code as an answer, I am not sure whether is the best solution or not, but it works!!
InitialTable[x_, y_, z_, w_] :=
MapAt[g,ReplacePart[
InitialMatrix[3, 3, 3, 3] +
ReplacePart[
Table[If[RandomReal[] > psurvival, -1,
0], {3}, {3}, {3}, {3}], {{_, _, 1, _} -> 0, {_, _, 2, _} ->
0}], {{_, _, 1, 2} -> 0, {_, _, 1, 3} -> 0}],
Flatten[Table[{i, j, 3, l}, {i, x}, {j, y}, {l, w}], 2]];
g[x_] := If[x < 0, 0, x];
If I want to find all possible sums from two lists list1 and list2, I use the Outer[] function with the specification of Plus as the combining operator:
In[1]= list1 = {a, b}; list2 = {c, d}; Outer[Plus, list1, list2]
Out[1]= {{a + c, a + d}, {b + c, b + d}}
If I want to be able to handle an arbitrary number of lists, say a list of lists,
In[2]= listOfLists={list1, list2};
then the only way I know how to find all possible sums is to use the Apply[] function (which has the short hand ##) along with Join:
In[3]= argumentsToPass=Join[{Plus},listOfLists]
Out[3]= {Plus, {a, b}, {c, d}}
In[4]= Outer ## argumentsToPass
Out[4]= {{a + c, a + d}, {b + c, b + d}}
or simply
In[5]= Outer ## Join[{Plus},listOfLists]
Out[5]= {{a + c, a + d}, {b + c, b + d}}
The problem comes when I try to compile:
In[6]= Compile[ ..... Outer ## Join[{Plus},listOfLists] .... ]
Compile::cpapot: "Compilation of Outer##Join[{Plus},listOfLists]] is not supported for the function argument Outer. The only function arguments supported are Times, Plus, or List. Evaluation will use the uncompiled function. "
The thing is, I am using a supported function, namely Plus. The problem seems to be solely with the Apply[] function. Because if I give it a fixed number of lists to outer-plus together, it works fine
In[7]= Compile[{{bob, _Integer, 1}, {joe, _Integer, 1}}, Outer[Plus, bob, joe]]
Out[7]= CompiledFunction[{bob, joe}, Outer[Plus, bob, joe],-CompiledCode-]
but as soon as I use Apply, it breaks
In[8]= Compile[{{bob, _Integer, 1}, {joe, _Integer, 1}}, Outer ## Join[{Plus}, {bob, joe}]]
Out[8]= Compile::cpapot: "Compilation of Outer##Join[{Plus},{bob,joe}] is not supported for the function argument Outer. The only function arguments supported are Times, Plus, or List. Evaluation will use the uncompiled function."
So my questions is: Is there a way to circumvent this error or, alternatively, a way to compute all possible sums of elements pulled from an arbitrary number of lists in a compiled function?
(Also, I'm not sure if "compilation" is an appropriate tag. Please advise.)
Thanks so much.
One way it to use With, to create a compiled function programmatically:
Clear[makeCompiled];
makeCompiled[lnum_Integer] :=
With[{listNames = Table[Unique["list"], {lnum}]},
With[{compileArgs = {#, _Integer, 1} & /# listNames},
Compile ## Join[Hold[compileArgs],
Replace[Hold[Outer[Plus, listNames]],
Hold[Outer[Plus, {x__}]] :> Hold[Outer[Plus, x]], {0}]]]];
It can probably be done prettier, but it works. For example:
In[22]:= p2 = makeCompiled[2]
Out[22]= CompiledFunction[{list13,list14},Outer[Plus,list13,list14],-CompiledCode-]
In[23]:= p2[{1,2,3},{4,5}]
Out[23]= {{5,6},{6,7},{7,8}}
In[24]:= p3 = makeCompiled[3]
Out[24]= CompiledFunction[{list15,list16,list17},Outer[Plus,list15,list16,list17],-CompiledCode-]
In[25]:= p3[{1,2},{3,4},{5,6}]
Out[25]= {{{9,10},{10,11}},{{10,11},{11,12}}}
HTH
Edit:
You can hide the compiled function behind another one, so that it is created at run-time and you don't actually see it:
In[33]:=
Clear[computeSums]
computeSums[lists : {__?NumberQ} ..] := makeCompiled[Length[{lists}]][lists];
In[35]:= computeSums[{1, 2, 3}, {4, 5}]
Out[35]= {{5, 6}, {6, 7}, {7, 8}}
You face an overhead of compiling in this case, since you create then a compiled function afresh every time. You can fight this overhead rather elegantly with memoization, using Module variables for persistence, to localize your memoized definitions:
In[44]:=
Clear[computeSumsMemoized];
Module[{compiled},
compiled[n_] := compiled[n] = makeCompiled[n];
computeSumsMemoized[lists : {__?NumberQ} ..] := compiled[Length[{lists}]][lists]];
In[46]:= computeSumsMemoized[{1, 2, 3}, {4, 5}]
Out[46]= {{5, 6}, {6, 7}, {7, 8}}
This is my first post. I hope I get this right.
If your inputs are lists of integers, I am skeptical of the value of compiling this function, at least in Mathematica 7.
For example:
f = Compile[{{a, _Integer, 1}, {b, _Integer, 1}, {c, _Integer, 1}, {d, _Integer, 1}, {e, _Integer, 1}},
Outer[Plus, a, b, c, d, e]
];
a = RandomInteger[{1, 99}, #] & /# {12, 32, 19, 17, 43};
Do[f ## a, {50}] // Timing
Do[Outer[Plus, ##] & ## a, {50}] // Timing
The two Timings are not significantly different for me, but of course this is only one sample. The point is merely that Outer is already fairly fast compared to the compiled version.
If you have reasons other than speed for compilation, you may find some use in Tuples instead of Outer, but you still have the constraint of compiled functions requiring tensor input.
f2 = Compile[{{array, _Integer, 2}},
Plus ### Tuples#array
];
f2[{{1, 3, 7}, {13, 25, 41}}]
If your inputs are large, then a different approach may be in order. Given a list of lists of integers, this function will return the possible sums and the number of ways to get each sum:
f3 = CoefficientRules#Product[Sum[x^i, {i, p}], {p, #}] &;
f3[{{1, 3, 7}, {13, 25, 41}}]
This should prove to be far more memory efficient in many cases.
a2 = RandomInteger[{1, 999}, #] & /# {50, 74, 55, 55, 90, 57, 47, 79, 87, 36};
f3[a2]; // Timing
MaxMemoryUsed[]
This took 3 seconds and minimal memory, but attempting the application of Outer to a2 terminated the kernel with "No more memory available."
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}