I want to write a
Module Arg[f_,n_]
that takes a function f (having <=n arguments) and a natural number n and outputs the n-th argument of the function f.
As an example, suppose that f is defined by
f[a_,b_]=a^2+b^2.
Then,
Arg[f[s,t],1]
should be s;
while
Arg[f[u,v],2]
should be v.
My question is whether this is possible. If so, what should I write in the place of "???" below?
Arg[f_,n_] := Module[{}, ??? ]
Note that I don't want to specify a_ and b_ in the definition of Arg like
Arg[f_,a_,b_,n_]
EDIT: "Arg" is just my name for the module not the internal function Arg of Mathematica.
Perhaps
SetAttributes[arg, HoldFirst];
arg[f_[x___], n_] := {x}[[n]]
f[a_, b_] := a^2 + b^2.
arg[f[arg[f[s, t], 1], t], 1]
arg[f[s, t], 2]
(*
-> s
-> t
*)
arg[ArcTan[f[Cos#Sin#x, x], t], 1]
(*
-> x^2. + Cos[Sin[x]]^2
*)
Assuming your second example should give u, this should do the job:
ClearAll[arg];
SetAttributes[arg, HoldFirst];
arg[g_, n_] := Module[
{tmp, ret},
Unprotect[Part];
tmp = Attributes[Part];
SetAttributes[Part, HoldFirst];
ret = Part[g, n];
ClearAttributes[Part, HoldFirst];
SetAttributes[Part, tmp];
Protect[Part];
ret
]
so that
f[a_, b_] = a^2 + b^2.;
arg[f[s, t], 1]
gives s.
This is very heavy-handed though, so I expect someone will find something better soon enough.
This is a bit better (doesn't redefine built-in functions even temporarily):
ClearAll[arg2];
SetAttributes[arg2, HoldFirst];
arg2[g_, n_] := Hold[g][[1, n]]
Related
I am trying to evaluate the derivative of a function at a point (3,5,1) in Mathematica. So, thats my input:
In[120]:= D[Sqrt[(z + x)/(y - 1)] - z^2, x]
Out[121]= 1/(2 (-1 + y) Sqrt[(x + z)/(-1 + y)])
In[122]:= f[x_, y_, z_] := %
In[123]:= x = 3
y = 5
z = 1
f[x, y, z]
Out[124]= (1/8)[3, 5, 1]
As you can see I am getting some weird output. Any hints on evaluating that derivative at (3,5,1) please?
The result you get for Out[124] leads me to believe that f was not cleared of a previous definition. In particular, it appears to have what is known as an OwnValue which is set by an expression of the form
f = 1/8
(Note the lack of a colon.) You can verify this by executing
g = 5;
OwnValues[g]
which returns
{HoldPattern[g] :> 5}
Unfortunately, OwnValues supersede any other definition, like a function definition (known as a DownValue or, its variant, an UpValue). So, defining
g[x_] := x^2
would cause g[5] to evaluate to 5[5]; clearly not what you want. So, Clear any symbols you intend to use as functions prior to their definition. That said, your definition of f will still run into problems.
At issue, is your use of SetDelayed (:=) when defining f. This prevents the right hand side of the assignment from taking on a value until f is executed later. For example,
D[x^2 + x y, x]
f[x_, y_] := %
x = 5
y = 6
f[x, y]
returns 6, instead. This occurs because 6 was last result generated, and f is effectively a synonym of %. There are two ways around this, either use Set (=)
Clear[f, x, y]
D[x^2 + x y, x];
f[x_, y_] = %
f[5, 6]
which returns 16, as expected, or ensure that % is replaced by its value before SetDelayed gets its hands on it,
Clear[f, x, y]
D[x^2 + x y, x];
f[x_, y_] := Evaluate[%]
I have
f1[x_, y_] := x^2 - 10 x + y^2 + 8;
f2[x_, y_] := x*y^2 + x - 10 y + 8;
f[x_, y_] := {f1[x, y], f2[x, y]} ;
x0 = {0, 0};
I want to evaluate f[x_, y_] in x0, so f[0, 0]
I am doing this but does not work, what is the correct way?
MatrixForm[f[{x0}]]
I get f[{{0, 0}}]
but want {8, 8} instead
In[61]:= f ## x0
Out[61]= {8, 8}
What went wrong? When you evaluate f[{x0}] this equals f[{{0,0}}], which doesn't match the defined pattern for f. f##x0, which is shorthand for Apply[f,x0], replaces the head of x0 (which internally equals List[0,0], hence its head is List), with f. You then get f[0,0] which matches the argument pattern of f. You then get the correct result.
I need to find fixed points of iterative map x[n] == 1/2 x[n-1]^2 - Mu.
My approach:
Subscript[g, n_ ][Mu_, x_] := Nest[0.5 * x^2 - Mu, x, n]
fixedPoints[n_] := Solve[Subscript[g, n][Mu, x] == x, x]
Plot[
Evaluate[{x,
Table[Subscript[g, 1][Mu, x], {Mu, 0.5, 4, 0.5}]}
], {x, 0, 0.5}, Frame -> True]
I'll change notation slightly (mostly so I myself can understand it). You might want something like this.
y[n_, mu_, x_] := Nest[#^2/2 - mu &, x, n]
fixedPoints[n_] := Solve[y[n, mu, x] == x, x]
The salient feature is that the "function" being nested now really is a function, in correct format.
Example:
fixedPoints[2]
Out[18]= {{x -> -1 - Sqrt[-3 + 2*mu]},
{x -> -1 + Sqrt[-3 + 2*mu]},
{x -> 1 - Sqrt[ 1 + 2*mu]},
{x -> 1 + Sqrt[ 1 + 2*mu]}}
Daniel Lichtblau
First of all, there is an error in your approach. Nest takes a pure function. Also I would use exact input, i.e. 1/2 instead of 0.5 since Solve is a symbolic rather than numeric solver.
Subscript[g, n_Integer][Mu_, x_] := Nest[Function[z, 1/2 z^2 - Mu], x, n]
Then
In[17]:= fixedPoints[1]
Out[17]= {{x -> 1 - Sqrt[1 + 2 Mu]}, {x -> 1 + Sqrt[1 + 2 Mu]}}
A side note:
Look what happens when you start very near to a fixed point (weird :) :
f[z_, Mu_, n_] := Abs[N#Nest[1/2 #^2 - Mu &, z, n] - z]
g[mu_] := f[1 + Sqrt[1 + 2*mu] - mu 10^-8, mu, 10^4]
Plot[g[mu], {mu, 0, 3}, PlotRange -> {0, 7}]
Edit
In fact, it seems you have an autosimilar structure there:
For example, I want mma to expand out the following differential operator
(1+d/dx+x*d2/dy2)^2*(1+y*d/dy)^2
I found Nest is not good enough to do this sort of things.
A bit dated, but see
http://library.wolfram.com/infocenter/Conferences/325/
The section "Some noncommutative algebraic manipulation" gives a few ways to go about this.
The first example, defining a function called differentialOperate, is probably best suited for your purposes.
---edit, reedited---
Here is the code I use. Probably it is (still) missing a few refinements. It is taken from a couple of examples in the notebook mentioned above.
I will define and use an auxiliary predicate, scalarQ. This gives the flexibility of declaring entities other than explicit numerical values to be scalar.
I define a noncommutative multiplication, called ncTimes. Ideally I would just use NonCommutativeMultiply, but Iwas not able to get the pattern matching to behave the way I wanted with respect to zero or one argument forms, or pulling out scalars. (Less technical explanation: it's mojo was more powerful than mine.)
scalarQ[a_?NumericQ] := True
scalarQ[_] := False
ncTimes[] := 1
ncTimes[a_] := a
ncTimes[a_, ncTimes[b_, c], d_] := ncTimes[a, b, c, d]
ncTimes[a_, x_ + y_, b_] := ncTimes[a, x, b] + ncTimes[a, y, b]
ncTimes[a_, i_?scalarQ*c_, b_] := i*ncTimes[a, c, b]
ncTimes[a_, i_?scalarQ, b___] := i*ncTimes[a, b]
differentialOperate[a_, expr_] /; FreeQ[a, D] := a*expr
differentialOperate[L1_ + L2_, expr_] :=
differentialOperate[L1, expr] + differentialOperate[L2, expr]
differentialOperate[a_*L_, expr_] /; FreeQ[a, D] :=
a*differentialOperate[L, expr]
differentialOperate[a : HoldPattern[D[] &], expr_] := a[expr]
differentialOperate[ncTimes[L1, L2_], expr_] :=
Expand[differentialOperate[L1, differentialOperate[L2, expr]]]
differentialOperate[L1_^n_Integer, expr_] /; n > 1 :=
Nest[Expand[differentialOperate[L1, #]] &, expr, n]
In[15]:= ddvar[x_, n_: 1] := D[#, {x, n}] &
Here are some of your examples, both from post and comments.
In[17]:= diffop =
ncTimes[(1 + ddvar[x] + ncTimes[x, ddvar[y, 2]])^2, (1 +
ncTimes[y, ddvar[y]])^2]
Out[17]= ncTimes[(1 + (D[#1, {x, 1}] & ) +
ncTimes[x, D[#1, {y, 2}] & ])^2,
(1 + ncTimes[y, D[#1, {y, 1}] & ])^2]
Apply this operator to f[x,y].
In[25]:= differentialOperate[diffop, f[x, y]]
Out[25]= f[x, y] + 3*y*Derivative[0, 1][f][x, y] +
9*Derivative[0, 2][f][x, y] +
18*x*Derivative[0, 2][f][x, y] + y^2*Derivative[0, 2][f][x, y] +
7*y*Derivative[0, 3][f][x, y] + 14*x*y*Derivative[0, 3][f][x, y] +
25*x^2*Derivative[0, 4][f][x, y] + y^2*Derivative[0, 4][f][x, y] +
2*x*y^2*Derivative[0, 4][f][x, y] +
11*x^2*y*Derivative[0, 5][f][x, y] +
x^2*y^2*Derivative[0, 6][f][x, y] + 2*Derivative[1, 0][f][x, y] +
6*y*Derivative[1, 1][f][x, y] + 18*x*Derivative[1, 2][f][x, y] +
2*y^2*Derivative[1, 2][f][x, y] +
14*x*y*Derivative[1, 3][f][x, y] +
2*x*y^2*Derivative[1, 4][f][x, y] + Derivative[2, 0][f][x, y] +
3*y*Derivative[2, 1][f][x, y] + y^2*Derivative[2, 2][f][x, y]
Those edge cases.
In[26]:= differentialOperate[ncTimes[1, 1], f[t]]
Out[26]= f[t]
We can declare a symbol to be scalar.
In[28]:= scalarQ[a] ^= True;
Now it will get pulled out as a simple multiplier.
In[29]:= differentialOperate[ncTimes[a, b], f[t]]
Out[29]= a b f[t]
---end edit---
Daniel Lichtblau
Wolfram Research
I'm generating a list of replacement rules like this
ops = {LessEqual, GreaterEqual};
ineqRules = Table[HoldPattern[Inequality[a_, op1, c_, _, e_]] -> a == c, {op1, ops}]
Above doesn't work because "op1" is hidden from Table by HoldPattern, how do I fix it?
This is a follow-up to previous question
How about
ops = {LessEqual, GreaterEqual};
ineqRules = (HoldPattern[Inequality[a_, #, c_, _, e_]] :> a == c) & /# ops
Edit: To fix the problem noted in belisarius's answer, try:
ineqRules=Flatten[{HoldPattern[Inequality[a_,#,c_,___]]:>a==c,HoldPattern[#[a_,c_]&&___]:>a==c}&/#ops]
This obviously depends on you having a simple structure to begin with, i.e. no other &&'s.
This is a job for With:
ops = {LessEqual, GreaterEqual};
ineqRules =
Table[
With[{op1=op1},
HoldPattern[Inequality[a_, op1, c_ ,_ ,e_]] -> a == c
],
{op1, ops}
]
I am sure there should be a better way, but this seems to work:
ops = {LessEqual, GreaterEqual};
ineqRules[op_] := HoldPattern[Inequality[a_, op, c_, _, e_]] -> a == c;
ineq = Table[ineqRules[op], {op, ops}];
Inequality[1, LessEqual, x, Less, 2] /. ineq
Out: 1 == x
HTH
Edit
Be carefull with this:
Inequality[e1, GreaterEqual, e2, Equal, e3] /. ineq
Out> e1 == e2
But
Inequality[1, GreaterEqual, e2, Equal, 2] /. ineq
Out> False
I guess some Hold[] beast is needed to get out of that if needed ... let us know