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.
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
To get acquainted with Mathematica's solving functions, I tried to work out a solution to a MinuteMath problem:
There is a list of seven numbers. The average of the first four numbers is 5, and the
average of the last four numbers is 8. If the average of all seven numbers is 46/7, then
what is the number common to both sets of four numbers?
Of course, this is an excercise that can be solved without computer, but how can I solve this using Mathematica? My first approach
X = Table[Subscript[x, i], {i, 1, 7}];
cond = {
Mean[Part[X, 1 ;; 4]] == 5,
Mean[Part[X, 4 ;; 7]] == 8,
Mean[X] == 46/7
};
Solve[cond, Subscript[x, 4]]
returned no solution. My second approach
X = Table[Subscript[x, i], {i, 1, 7}];
rules = {Mean[Part[X, 1 ;; 4]] -> 5,
Mean[Part[X, 4 ;; 7]] -> 8,
Mean[X] -> 46/7
};
Solve[
Mean[X] == Mean[Part[X, 1 ;; 4]]
+ Mean[Part[X, 4 ;; 7]]
- Subscript[x, 4] /. rules,
Subscript[x, 4]
]
gives a wrong solution (45/7 instead 6). What did I wrong?
The first piece of code that you give is fine. The only problem is there is no solution for x_4 alone. If you replace the last line by Solve[cond] then Mathmatica automagically chooses the free variables and you'll get the solution.
I think that a simple/trivial example would make this type problem clear:
In[1]:= Solve[x==1&&y==2,x]
Solve[x==1&&y==2,{x,y}]
Out[1]= {}
Out[2]= {{x->1,y->2}}
The final output can also be obtained using Solve[x==1&&y==2], where Mma guesses the free variables. This behaviour differs from that of Mathematica 7. In Mathematica 8 a new option for Solve (and related functions) called MaxExtraCondtions was introduced. This allows Solve to give solutions that use the new ConditionalExpression and is intended to make the behaviour of solve more consistent and predictable.
Here's how it works in this simple example:
In[3]:= Solve[x==1&&y==2, x, MaxExtraConditions->1]
Out[3]= {{x -> ConditionalExpression[1, y==2]}}
See the above linked to docs for more examples that show why this Option is useful. (Although maybe defaulting to Automatic instead of 0 would be a more pragmatic design choice for the new option...)
Finally, here's your first solution rewritten a little:
In[1]:= X=Array[Symbol["x"<>ToString[#]]&,{7}]
Out[1]= {x1,x2,x3,x4,x5,x6,x7}
In[2]:= cond=Mean[X[[1;;4]]]==5&&Mean[X[[4;;7]]]==8&&Mean[X]==46/7;
In[3]:= Solve[cond]
x4/.%
Out[3]= {{x1->14-x2-x3,x4->6,x5->26-x6-x7}}
Out[4]= {6}
Perhaps more compact:
Reduce[Mean#Array[f, 4] == 5 &&
Mean#Array[f, 4, 4] == 8 &&
Mean#Array[f, 7] == 46/7]
(*
-> f[5] == 26 - f[6] - f[7] &&
f[4] == 6 &&
f[1] == 14 - f[2] - f[3]
*)
Although for clarity, I probably prefer:
Reduce[Sum[f#i, {i, 4}] == 20 &&
Sum[f#i, {i, 4, 7}] == 32 &&
Sum[f#i, {i, 7}] == 46]
Edit
Note that I am using function upvalues as vars and not list elements. I prefer this way because:
You don't need to initialize the list
(Table[Subscript ... in your
example`)
The resulting expressions are usually
less cluttered (No Part[ ;; ], etc)
I'm having some problems with writing a function that takes options. One of the option values is a function. I one to get at this value but keep it unevaluated. I tried every single thing I could possibly think of but nothing worked so far.
Basically, to illustrate this is what I tried:
SetAttributes[Foo, HoldRest];
Options[Foo] = {Blah -> None}
Foo[x_, OptionsPattern[]] :=
Module[{blah},
blah = OptionValue[Automatic, Automatic, Blah, Hold];
.
.
.
Then when I have:
func[a_, b_, c_] := a + b + c;
I'd like to be able to call Foo with:
Foo[2, Blah -> func[1, 2, 3]]
And have the "blah" variable (inside Foo) to be unevaluated, i.e. blah = func[1, 2, 3].
Thanks for all the help in advance!
Edit:
For reasons that are too long to elaborate, I cannot use RuleDelayed (:>). I'm trying to write a function that will be in a package, used by other people that don't really know Mathematica, so they would have no clue what :> is. Using rules (->) for specifying options and their values is the standard way and they familiar with that.
So to further illustrate, let's say that I'm trying to write a number generator function that takes a function that generates the actual number as one of it's options:
Options[GenerateNumbers] = {GeneratorFunction -> None};
GenerateNumbers[n_, OptionsPattern[]] :=
Module[{func},
func = OptionValue[GeneratorFunction];
Table[func, {n}]
]
]
Now, if I called this function with values as follows:
GenerateNumbers[5, GeneratorFunction -> RandomReal[10]]
It would return a list of 5 numbers that are the same, since RandomReal[10] gets evaluated once and not at every iteration of Table. I want to prevent this. The problem is more complicated but it's along these lines.
Thanks!
Use a name for the OptionsPattern and then wrap the captured sequence object with a List and an Unevaluated. A very minimal way of capturing the right-hand side for Blah is:
SetAttributes[Foo, HoldRest]; Options[Foo] = {Blah -> None};
Foo[x_, opts : OptionsPattern[]] :=
Module[{blah},
blah = OptionValue[Foo, Unevaluated[{opts}], Blah, Hold];
blah]
Testing it out:
In[2]:= Foo[x, Blah -> (1 + 1)]
Out[2]= Hold[1 + 1]
Why don't you use RuleDelayed?
Foo[2, Blah :> func[1, 2, 3]]
In this case blah=Hold[func[1, 2, 3]] as expected.
Your usage of the options is a little strange. If you want to pass some expression wrapped in Hold, why not wrap it in Hold when passing, like Blah->Hold[func[1,2,3]]? Anyway, assuming this simple definition for Foo:
Foo[x_, OptionsPattern[]] :=
Module[{blah},
blah = OptionValue[Automatic, Automatic, Blah, Hold];
blah
],
you can accomplish what you want by passing an option with RuleDelayed rather than Rule:
In[7]:= func[a_, b_, c_] := a + b + c;
In[8]:= Foo[2, Blah :> func[1, 2, 3]]
Out[8]= Hold[func[1, 2, 3]]
HTH
Edit:
If you don't want Hold wrapped around, here is one way to get rid of it:
In[25]:=
ClearAll[setDelayedHeld];
SetAttributes[setDelayedHeld, HoldFirst];
setDelayedHeld[lhs_, Hold[rhs_]] := lhs := rhs
In[28]:=
Clear[Foo];
Foo[x_, OptionsPattern[]] :=
Module[{blah},
setDelayedHeld[blah, OptionValue[Automatic, Automatic, Blah, Hold]];
OwnValues[blah]]
In[30]:= Foo[2, Blah :> func[1, 2, 3]]
Out[30]= {HoldPattern[blah$1018] :> func[1, 2, 3]}
I return OwnValues for blah to show that it was assigned func[1,2,3] without evaluating the latter - if this is what you want.
I have discovered that InString[] does not work in MathLink mode when sending input with EnterExpressionPacket header. So I need to define my own function that returns previous input line. One way I have developed here does not work in some cases:
In[1]:= Unevaluated[2 + 2]
With[{line = $Line - 1}, HoldForm[In[line]]] /. (DownValues[In])
Out[1]= Unevaluated[2 + 2]
Out[2]= 2 + 2
This is because RuleDelayed has no HoldAllComplete attribute. Adding this attribute makes this OK:
In[1]:= Unprotect[RuleDelayed];
SetAttributes[RuleDelayed, HoldAllComplete];
Protect[RuleDelayed];
Unevaluated[2 + 2]
With[{line = $Line - 1}, HoldForm[In[line]]] /. DownValues[In]
Out[4]= Unevaluated[2 + 2]
Out[5]= Unevaluated[2 + 2]
But modifying built-in functions generally is not a good idea. Is there a better way to do this?
It seems that I have solved the problem. Here is the function:
In[1]:=
getLastInput := Module[{num, f},
f = Function[{u, v},
{u /. {In -> num, HoldPattern -> First}, HoldForm[v]}, HoldAllComplete];
First#Cases[
Block[{RuleDelayed = f}, DownValues[In]],
{$Line - 1, x_} -> x, {1}, 1]]
In[2]:=
Unevaluated[2+2]
getLastInput
Out[2]=
Unevaluated[2+2]
Out[3]=
Unevaluated[2+2]
And I just have got the answer to the question on InString in MathLink mode from Todd Gayley (Wolfram Research):
InString is only assigned when using
EnterTextPacket, not
EnterExpressionPacket. There is no
string form of the input when sending
EnterExpressionPacket (whose content
is, by definition, already an
expression).
EDIT:
I just have found that my code does not work with input expressions with head Evaluate. The solution is to replace HoldForm by HoldComplete in my code:
getLastInput := Module[{num, f},
f = Function[{u, v},
{u /. {In -> num, HoldPattern -> First}, HoldComplete[v]}, HoldAllComplete];
First#Cases[
Block[{RuleDelayed = f}, DownValues[In]],
{$Line - 1, x_} -> x, {1}, 1]]
This works well. Another approach would be to unprotect HoldForm and set up attribute HoldAllComplete on it. I'm wondering why HoldForm does not have this attribute by default?
EDIT 2:
In the comments for the main question Leonid Shifrin suggested much better solution:
getLastInput :=
Block[{RuleDelayed},SetAttributes[RuleDelayed,HoldAllComplete];
With[{line=$Line-1},HoldComplete[In[line]]/.DownValues[In]]]
See comments for details.
EDIT 3:
The last code can be made even better for by replacing HoldComplete by double HoldForm:
getLastInput :=
Block[{RuleDelayed},SetAttributes[RuleDelayed,HoldAllComplete];
With[{line=$Line-1},HoldForm#HoldForm[In[line]]/.DownValues[In]]]
The idea is taken from presentation by Robby Villegas of Wolfram Research at the 1999 Developer Conference. See subsection "HoldCompleteForm: a non-printing variant of HoldComplete (just as HoldForm is to Hold)" in "Working With Unevaluated Expressions" notebook posted here.
I would use $Pre and $Line for this; unlike $PreRead, it's applied to input expressions, not input strings or box forms. All you need is to assign it a function that has the HoldAllComplete attribute, like this one which I've adapted from the example in the documentation:
SetAttributes[saveinputs, HoldAllComplete];
saveinputs[new_] :=
With[{line = $Line},
inputs[line] = HoldComplete[new]; new]
$Pre = saveinputs;
I tested this with MathLink, and the behavior seems to be what you desired (I've elided some of the transcript to highlight the key point):
In[14]:= LinkWrite[link,
Unevaluated[
EnterExpressionPacket[
SetAttributes[saveinputs, HoldAllComplete];
saveinputs[new_] :=
With[{line = $Line},
inputs[line] = HoldComplete[new]; new];
$Pre = saveinputs;]]]
In[15]:= LinkRead[link]
Out[15]= InputNamePacket["In[2]:= "]
In[20]:= LinkWrite[link,
Unevaluated[EnterExpressionPacket[Evaluate[1 + 1]]]]
In[21]:= LinkRead[link]
Out[21]= OutputNamePacket["Out[2]= "]
In[21]:= LinkRead[link]
Out[21]= ReturnExpressionPacket[2]
In[24]:= LinkWrite[link, Unevaluated[EnterExpressionPacket[DownValues[inputs]]]]
In[26]:= LinkRead[link]
Out[26]= ReturnExpressionPacket[
{HoldPattern[inputs[2]] :> HoldComplete[Evaluate[1 + 1]],
HoldPattern[inputs[3]] :> HoldComplete[DownValues[inputs]]}]
I just have found simpler but dangerous way:
In[3]:= Unevaluated[2 + 2]
Trace[In[$Line - 1]] // Last
Trace[In[$Line - 1]] // Last
Out[3]= Unevaluated[2 + 2]
Out[4]= Unevaluated[2 + 2]
During evaluation of In[3]:= $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>
During evaluation of In[3]:= $RecursionLimit::reclim: Recursion depth of 256 exceeded. >>
During evaluation of In[3]:= $IterationLimit::itlim: Iteration limit of 4096 exceeded. >>
Out[5]= Hold[In[$Line-1]]
Does anybody know a way to make it safe?