Solving a complicated formula f(u,v)==0, where
I assign some constant value to u and then solve v.
I can solve it without for-loop, but encounter errors by adding For[] enclosing the codes,
where saying
Set::write: Tag Times in "Solve[] with exact coefficients solns is Protected.
A simple example to illustrate my idea:
For[ i = 1, i < 5, i++,
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y]
]
will get error:
Set::write: "Tag Times in (-9+y^2) is Protected."
Only when I add For[ ] at the outside of the code
(inner 4-line code works fine without for loop)
So it seems that there is an variable assignment permission issue in the for loop
How can I avoid it?
I no longer have Mathematica 7 installed, and your code runs (although with no printed output...) on Mathematica 10. Based on the error message, it sounds like you need to Clear[f] before trying to reassign it.
For[i = 1, i < 5, i++,
Clear[f];
f = x^2 + y^2 - 10;
x = i;
eqn = (f == 0);
soln = Solve[eqn, y];
Print[soln]
]
However, you're still really mixing things up. Consider what happens with your code as the loop executes. First it starts with i=1 and says:
Clear[f] -- or don't, this isn't the only issue
f = x^2 + y^2 - 10 -- This gives me an expression with symbols x and y
x=i -- This sets x=1 since i=1 already
At this point, the expression for f has become y^2 - 9`. Next time it comes around, it will repeat:
f = x^2 + y^2 - 10 -- But x is no longer a symbol!! So now it still treats x=1...
This becomes a nightmare. I could try to hack your code into working with the fewest changes (e.g. make it Clear[f,x] or something), but that's not really the best advice I can give.
A better overall construction would be something like:
Eqn[x_,y_]=(x^2+y^2-10==0);
For[i=1,i<5,i++,
Print[Solve[Eqn[i,y],y]];
];
Your function f is a function, so you should make it a function like f[x_,y_]=something. Better yet, just make the entire equation into a function as above. That way, you never actually modify the values of x or y and don't get caught with issues in your loop.
And before you use this new code I've given you, clear everything or just quit the Kernel.
Related
I have been away from Mathematica for quite a while and am trying to fix some old notebooks from v4 that are no longer working under v11. I'm also a tad rusty.
I am attempting to use functional minimization to fit a polynomial of variable degree to an arbitrary function (F) given a starting guess (ao) and domain of interest (d). Note that while F is arbitrary, its nature is such that the integral of the product of F and a polynomial (or F^2) can always be evaluated algebraically.
For the sake of example, I'll use the following inputs:
ao = { 1, 2, 3, 4 }
d = { -1, 1 }
F = Sin[x]
To do so, I create an array of 'indexed' variables
polyCoeff = Array[a,Length[a],0]
Result: polycoeff = {a[0], a[1], a[2], a[3]}
I then create the polynomial itself using the following
genPoly[{},x_] := 0
genPoly[a_List,x_] := First[a] + x genPoly[Rest[a],x]
poly = genPoly[polyCoeff,x]
Result: poly = a[0] + x (a[1] + x (a[2] + x a[3]))
I then define my objective function as the integral of the square of the error of the difference between this poly and the function I am attempting to fit:
Q = Integrate[ (poly - F[x])^2, {x, d[[1]],d[[2]]} ]
result: Q = 0.545351 - 2. a[0.]^2 + 0.66667 a[1.]^2 + .....
And this is where things break down. poly looks just as I expected: a polynomial in x with coefficients that look like a[0], a[1], a[2], ... But, Q is not exactly what I expected. I expected and got a new polynomial. But not the coefficients contained a[0.], a[1.], a[2.], ...
The next step is to create the initial guess for FindMinimum
init = Transpose[{polyCoeff,ao}]
Result: {{a[0],1},{a[1],2},{a[3],3},{a[4],4}}
This looks fine.
But when I make the call to FindMinimum, I get an error because the coefficients passed in the objective (a[0.],a[1.],...) do not match those passed in the initial guess (a[0],a[1],...).
S = FindMinimum[Q,init]
So I think my question is how do I keep Integrate from changing the arguments to my coefficients? But, I am open to other approaches as well. Keep in mind though that this is "legacy" work that I really don't want to have to completely revamp.
Thanks much for any/all help.
I'm currently stuck on a loop invariant proof in my home assignment. The algorithm that I need to prove correctness of, is:
Multiply(a,b)
x=a
y=0
WHILE x>=b DO
x=x-b
y=y+1
IF x=0 THEN
RETURN(y)
ELSE
RETURN(-1)
I've tried to look at several examples of loop invariants and I have some sense of idea of how its supposed to work out. However in this algorithm above, I have two exit conditions, and I'm a bit lost on how to approach this in a loop invariant proof. In particular its the termination part I'm struggling with, around the IF and ELSE statements.
So far what I've constructed is simply by looking at the termination of the algorithm in which case if x = 0 then it returns the value of y containing the value of n (number of iterations in the while loop), where as if x is not 0, and x < b then it returns -1. I just have a feeling I need to prove this some how.
I hope someone can help share some light on this for me, as the similar cases I've found in here, have not been sufficient.
Thanks alot in advance for your time.
Provided that the algorithm terminates (for this let's assume a>0 and b>0, which is sufficient), one invariant is that at every iteration of your while loop, you have x + by = a.
Proof:
at first, x = a and y = 0 so that's ok
If x + by = a, then (x - b) + (y + 1)b = a, which are the values of x and y for your next iteration
Illustration:
Multiply(a,b)
x=a
y=0
// x + by = a, is true
WHILE x>=b DO
// x + by = a, is true
x=x-b // X = x - b
y=y+1 // Y = y + 1
// x + by = a
// x - b + by + b = a
// (x-b) + (y+1)b = a
// X + bY = a, is still true
// x + by = a, will remain true when you exit the loop
// since we exited the loop, x < b
IF x=0 THEN
// 0 + by = a, and 0 < b
// y = a/b
RETURN(y)
ELSE
RETURN(-1)
This algorithm returns a/b when b divides a, and -1 otherwise. Multiply does not quite sound like an appropriate name for it...
We can't prove correctness without a specification of exactly what the function is supposed to do, which I can't find in your question. Even the name of the function doesn't help: as noted already, your function returns a/b most of the time when b divides a, and -1 otherwise. Multiply is an inappropriate name for it.
Furthermore, if b=0 and a>=b the "algorithm" doesn't terminate so it isn't even an algorithm.
As Alex M noted, a loop invariant for the loop is x + by = a. At the moment the loop exits, we also have x < b. There are no other guarantees on x because (presumably) a could be negative. If we had a guarantee that a and b are positive, then we could guarantee that 0<=x<b at the moment the loop exits, which would mean that it implements the division with remainder algorithm (at the end of the loop, y is quotient and x is remainder, and it terminates by an "infinite descent" type argument: a decreasing sequence of positive integers x must terminate). Then you could conclude that if x=0, b divides a evenly, and the quotient is returned, otherwise -1 is returned.
But that is not a proof, because we are lacking a specification for what the algorithm is supposed to do, and a specification on restrictions on its inputs. (Are a and b any positive integers? Negative and 0 not allowed?)
given the constants
mu = 20.82;
ex = 1.25;
kg1 = 1202.76;
kp = 76.58;
kvb = 126.92;
I need to invert the function
f[Vpx_,Vgx_] := Vpx Log[1 + Exp[kp (1/mu + Vgx/(Vpx s[Vpx]))]];
where
s[x_] := 1 + kvb/(2 x^2);
so that I get a function of two variables, the second one being Vgx.
I tried with
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2];
tested with t[451,-4]
It takes so much time that every time I try it I stop the evaluation.
On the other side, working with only one variable, everything works:
Vgx = -4;
t = InverseFunction[Function[{Vpx}, f[Vpx,Vgx]]];
t[451]
It's my fault? the method is inappropriate? or it's a limitation of Wolfram Mathematica?
Thanks
Teodoro Marinucci
P.S. For everyone interested it's a problem related to the Norman Koren model of triodes.
As I said in my comment, my guess is that InverseFunction first tries to solve symbolically for the inverse, e.g. Solve[Function[{Vpx, Vgx}, f[Vpx, Vgx]][X, #2] == #1, X], which takes a very long time (I didn't let it finish). However, I came across a system option that seems to turn this off and produce a function:
With[{opts = SystemOptions["ExtendedInverseFunction"]},
Internal`WithLocalSettings[
SetSystemOptions["ExtendedInverseFunction" -> False],
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2],
SetSystemOptions[opts]
]];
t[451, -4]
(* 199.762 *)
A couple of notes:
According to the documentation, InverseFunction with exact input should produce an exact answer. Here some of the parameters are approximate (floating-point) real numbers, so the answer above is a numerical approximation.
The actual definition of t depends on f. If f changes, then a side effect will be that t changes. If that is not something you explicitly want, then it is probably better to define t this way:
t = InverseFunction[Function[{Vpx, Vgx}, Evaluate#f[Vpx, Vgx]], 1, 2]
As my late Theoretical Physics professor said, "a simple and beautiful solution is likely to be true".
Here is the piece of code that works:
mu = 20.82; ex = 1.25; kg1 = 1202.76; kp = 76.58; kvb = 126.92;
Ip[Vpx_, Vgx_] = Power[Vpx/kp Log[1 + Exp[kp (1/mu + Vgx/Sqrt[kvb + Vpx^2])]], ex] 2/kg1;
Vp[y_, z_] := x /. FindRoot[Ip[x, z] == y, {x, 80}]
The "real" amplification factor of a tube is the partial derivative of Ip[Vpx, Vgx] by respect to Vgx, with give Vpx. I would be happier if could use the Derivative, but I'm having errors.
I'll try to understand why, but for the moment the definition
[CapitalDelta]x = 10^-6;
[Micro][Ipx_, Vgx_] := Abs[Vp[Ipx, Vgx + [CapitalDelta]x] - Vp[Ipx, Vgx]]/[CapitalDelta]x
works well for me.
Thanks, it was really the starting point of the FindRoot the problem.
I am writing a debug function, which prints a variable name, and its value. I call this debug function with a list of variables from anywhere in the program. So the idea is for it to work like this:
debug[var_List] := Module[{values = ReleaseHold[var], i},
For[i = 1, i <= Length[values], i++,
Print[var[[i]], " = ", values[[i]]]
]
];
Now I use the above, like this
x = 3; y = 5;
debug[{HoldForm[x], HoldForm[y]}]
and I see in the console the following
x = 3
y = 5
But I have a large program and long list of variables at different places I want to debug. And I do not want to type HoldForm to each variable to make up the list to call the debug[] function. Much easier to Map it if possible. Less typing each time. But this does not work:
debug[ Map[HoldForm,{x,y}]]
The reason is that {x,y} was evaluated before HoldForm got hold of it. So I end up with a list that has the values in it, like this:
3 = 3
5 = 5
I could not find a way to Map HoldForm without the list being evaluated.
The best I could find is this:
debug[HoldForm[Defer[{x, y}]]]
which gives the following output from the above debug[] function:
{x,y} = {3,5}
Since Defer[{x, y}] has length 1, and it is just one thing, I could not break it up to make a 2 column list like in the above example.
It will be better if I can get an output of the form
x = 3
y = 5
easier to match the variable with its value since I have many variables.
question is: Any one knows of a programming trick to convert HoldForm[{x,y}] to {HoldForm[x],HoldForm[y]}
thanks
Just use Thread:
Thread[HoldForm[{x, y}]]
alternatively,
Map[HoldForm, Unevaluated[{x, y}]]
Here is a longer alternative demonstrating use of Hold, found in Roman Maeder's Programming In Mathematica (3rd ed.), page 137:
e1 = Hold[{x, y}];
e2 = MapAt[Hold, e1, {1, 0}];
e3 = Map[HoldForm, e2, {2}];
e4 = MapAt[ReleaseHold, First[e3], {0}];
debug[e4]
x=3
y=5
I did a PrintIt function using attributes that does what you want. I posted it here https://stackoverflow.com/a/8270643/884752, I repeat the code:
SetAttributes[System`ShowIt, HoldAll];
System`ShowIt[code__] := System`ShowIt[{code}];
System`ShowIt[code_] :=
With[{y = code},
Print[Defer[code = y]];
y
];
SetAttributes[System`PrintIt, {HoldAll,Listable}];
System`PrintIt[expr__]:=System`PrintIt[{expr}];
System`PrintIt[expr_] := System`ShowIt[expr];
Memoized functions are functions which remember values they have found.
Look in the doc center for some background on this in Mathematica, if necessary.
Suppose you have the following definition
f[0] = f[1] = 1
f[x_] := f[x] = f[x - 1] + f[x - 2]
in one of your packages. A user may load the package and start asking right away f[1000].
This will trigger a $RecursionLimit::reclim error message and abort.
Even if the user then tries something smaller, say f[20], by now the definition of f is corrupt and the result is not good anymore.Of course the package developer might increase the recursion limit and warn the user, but my question is:
How can you improve the f definition so that if the user asks for f[1000] he/she gets the answer without any problem? I am interested in a way to trap the user input, analyze it and take whatever steps are necessary to evaluate f[1000].
I can easily imagine that one can change the recursion limit if the input is more than 255 (and then bring it back to the original level), but what I would really like to see is, if there is a way for the f to find out how many values it "knows" (fknownvalues) and accept any input <=fknownvalues+$RecursionLimit without problems or increase the $RecursionLimit if the input is higher.
Thank you for your help
Here is the code assuming that you can determine a value of $RecursionLimit from the value of the input argument:
Clear[f];
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] := ff[x] = ff[x - 1] + ff[x - 2];
f[x_Integer] :=f[x] =
Block[{$RecursionLimit = x + 5},
ff[x]
]]
I am using a local function ff to do the main work, while f just calls it wrapped in Block with a proper value for $RecursionLimit:
In[1552]:= f[1000]
Out[1552]= 7033036771142281582183525487718354977018126983635873274260490508715453711819693357974224
9494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125
598767690091902245245323403501
EDIT
If you want to be more precise with the setting of $RecursionLimit, you can modify the part of the code above as:
f[x_Integer] :=
f[x] =
Block[{$RecursionLimit = x - Length[DownValues[ff]] + 10},
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]]
The Print statement is here for illustration. The value 10 is rather arbitrary - to get a lower bound on it, one has to compute the necessary depth of recursion, and take into account that the number of known results is Length[DownValues[ff]] - 2 (since ff has 2 general definitions). Here is some usage:
In[1567]:= f[500]//Short
During evaluation of In[1567]:= Current $RecursionLimit: 507
Out[1567]//Short= 22559151616193633087251269<<53>>83405015987052796968498626
In[1568]:= f[800]//Short
During evaluation of In[1568]:= Current $RecursionLimit: 308
Out[1568]//Short= 11210238130165701975392213<<116>>44406006693244742562963426
If you also want to limit the maximal $RecursionLimit possible, this is also easy to do, along the same lines. Here, for example, we will limit it to 10000 (again, this goes inside Module):
f::tooLarge =
"The parameter value `1` is too large for single recursive step. \
Try building the result incrementally";
f[x_Integer] :=
With[{reclim = x - Length[DownValues[ff]] + 10},
(f[x] =
Block[{$RecursionLimit = reclim },
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]) /; reclim < 10000];
f[x_Integer] := "" /; Message[f::tooLarge, x]]
For example:
In[1581]:= f[11000]//Short
During evaluation of In[1581]:= f::tooLarge: The parameter value 11000 is too
large for single recursive step. Try building the result incrementally
Out[1581]//Short= f[11000]
In[1582]:=
f[9000];
f[11000]//Short
During evaluation of In[1582]:= Current $RecursionLimit: 9007
During evaluation of In[1582]:= Current $RecursionLimit: 2008
Out[1583]//Short= 5291092912053548874786829<<2248>>91481844337702018068766626
A slight modification on Leonid's code. I guess I should post it as a comment, but the lack of comment formatting makes it impossible.
Self adaptive Recursion Limit
Clear[f];
$RecursionLimit = 20;
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] :=
ff[x] = Block[{$RecursionLimit = $RecursionLimit + 2}, ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
f[30]
(*
-> 1346269
*)
$RecursionLimit
(*
-> 20
*)
Edit
Trying to set $RecursionLimit sparsely:
Clear[f];
$RecursionLimit = 20;
Module[{ff}, ff[0] = ff[1] = 1;
ff[x_] := ff[x] =
Block[{$RecursionLimit =
If[Length#Stack[] > $RecursionLimit - 5, $RecursionLimit + 5, $RecursionLimit]},
ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
Not sure how useful it is ...