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
Related
I need to use NDSolve which in turn uses the solution from another ODE as function in terms of output from another NDSolve.
If I use the exact solution from the first differential equation inside the NDSolve, it's OK. But when I use the same solution in the form of function (which uses InterpolatingFunction) it does not work.
I believe, it's got to do with the structure of NDSolve output. Could anyone please enlighten me on this. Will be of great help!
The code is:
feq = 2 V alpha fip F''[fi] - (V^2 - (V^2 + sigma - 2 fi) (F'[fi])^2 + (F'[fi])^4
Frange[lo_, hi_] :=
Module[{fii, sol},
sol = NDSolve[{(feq == 0 /.fi -> fii), F[0] == 0}, F, {fii, lo, hi}]]
eqpois = fi''[x] == ne[x] - F[fi[x]]/.sol
NDSolve[{eqpois, fi'[0] == 0, fi[0] == 0}, fi, {x,0,1}]
Here in order to find F[phi], I need to solve the 1st diff eq that is feq, which is solved by NDSolve inside the function Frange[lo,hi]. The solution is then used inside the second equation eqpois, which has to be solved using NDSolve again. The problem comes up in the second NDSolve, which does not produce the result. If I use the analytical solution of F[phi] in eqopis, then there is no problem.
Example Problem
I have done a little experiment with this. Let's take an example of coupled ODEs
1st eqn : dg/dx = 2f(g) with initial condition g(0) = 1
The function f(y) is a solution from another ODE, say,
2nd eqn : df/dy = 2y with IC f(0) = 0
The solution of the 2nd ODE is f(y) = y^2 which when put into the the 1st ODE becomes
dg/dx = 2 g^2 and the final solution is g(x) = 1/(1-2x)
The issue:
When I use DSolve, it finds the answer correctly
In[39]:= s = DSolve[{f'[y] == 2 y, f[0] == 0}, f, y]
Out[39]= {{f -> Function[{y}, y^2]}}
In[40]:= ss = DSolve[{g'[x] == 2 (f[g[x]]/.First#s), g[0] == 1}, g, x]
Out[40]= {{g -> Function[{y}, 1/(1 - 2 x)]}}
The problem comes when I use NDSolve
In[41]:= s = NDSolve[{f'[y] == 2 y, f[0] == 0}, f, {y, 1, 5}]
Out[41]= {{f -> InterpolatingFunction[{{1., 5.}}, <>]}}
In[42]:= ss1 = NDSolve[{g'[x] == 2 (Evaluate[f[g[x]]/.First#s1]), g[0] == 1}, g, {x, 1, 2}]
Out[42]= {}
The erros are:
During evaluation of In[41]:= InterpolatingFunction::dmval: Input value {2.01726} lies outside the range of data in the interpolating function. Extrapolation will be used. >>
During evaluation of In[41]:= InterpolatingFunction::dmval: Input value {2.01726} lies outside the range of data in the interpolating function. Extrapolation will be used. >>
During evaluation of In[41]:= InterpolatingFunction::dmval: Input value {2.04914} lies outside the range of data in the interpolating function. Extrapolation will be used. >>
During evaluation of In[41]:= General::stop: Further output of InterpolatingFunction::dmval will be suppressed during this calculation. >>
During evaluation of In[41]:= NDSolve::ndsz: At y == 0.16666654771477857, step size is effectively zero; singularity or stiff system suspected. >>
During evaluation of In[41]:= NDSolve::ndsz: At y == 0.16666654771477857, step size is effectively zero; singularity or stiff system suspected. >>
Any help in this regard will be highly appreciated!
--- Madhurjya
I got your simple example to work with a little mod ..
f0 = First#First#DSolve[{f'[y] == 2 y, f[0] == 0}, f, y]
g0 = g /.
First#First#DSolve[{g'[x] == 2 (f[g[x]] /. f0), g[0] == 1}, g, x]
fn = f /. First#First#NDSolve[{f'[y] == 2 y, f[0] == 0}, f, {y, 0, 10}]
gn = g /.
First#First#
NDSolve[{g'[x] == 2 (fn[g[x]]), g[0] == 1}, g, {x, 0, 9/20}]
GraphicsRow[{
Plot[{g0#x, gn#x}, {x, 0, 9/20},
PlotStyle -> {{Thick, Black}, {Thin, Red, Dashed}}],
Plot[{f#x /. f0, fn#x}, {x, 0, 2},
PlotStyle -> {{Thick, Black}, {Thin, Red, Dashed}}]}]
note we need to ensure the y range in the first NDSolve is sufficient to cover the expected range of g from the second. That is where all those interpolation range errors come from.
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]]
How can I get the indices of a selection rather than the values. I.e.
list={3->4, 5->2, 1->1, 5->8, 3->2};
Select[list, #[[1]]==5&]; (* returns {5->2, 5->8} *)
I would like something like
SelectIndices[list, #[[1]]==5&]; (* returns {2, 4} *)
EDIT: I found an answer to the immediate question above (see below), but what about sorting. Say I want to sort a list but rather than returning the sorted list, I want to return the indices in the order of the sorted list?
Ok, well, I figured out a way to do this. Mathematica uses such a different vocabulary that searching the documentation still is generally unfruitful for me (I had been searching for things like, "Element index from Mathematica Select", to no avail.)
Anyway, this seems to be the way to do this:
Position[list, 5->_];
I guess its time to read up on patterns in Mathematica.
WRT to the question remaining after your edit: How about Ordering?
In[26]:= Ordering[{c, x, b, z, h}]
Out[26]= {3, 1, 5, 2, 4}
In[28]:= {c, x, b, z, h}[[Ordering[{c, x, b, z, h}]]]
Out[28]= {b, c, h, x, z}
In[27]:= Sort[{c, x, b, z, h}]
Out[27]= {b, c, h, x, z}
I think you want Ordering:
Sort[list, #[[1]] == 5 &]
Ordering[list, All, #[[1]] == 5 &]
(*
{5->2,5->8,3->2,1->1,3->4}
{2,4,5,3,1}
*)
Sorry, I had read your question to fast.
I think your second question is about how to sort the list according to the values of the rules. The simplest way that come to mind is by using a compare function. then simply use your solution to retrieve the indices:
comp[_ -> x_, a_ -> y_] := x < y;
Position[Sort[list, comp], 5 -> _]
Hope this helps!
Without sorting or otherwise altering the list, do this:
SelectIndex[list_, fn_] := Module[{x},
x = Reap[For[i = 1, i < Length[list], i++, If[fn[list[[i]]], Sow[i], Null];]];
If[x[[1]] == {}, {}, x[[2, 1]]]]
list={ {"foo",1}, {"bar",2}};
SelectIndex[list, StringMatchQ[ #[[1]], "foo*"] &]
You can use that to extract records from a database
Lookup[list_, query_, column_: 1, resultColumns_: All] := list[[SelectIndex[list, StringMatchQ[query, #[[column]]] &], resultColumns]]
Lookup(list,"foo")
I'd like to extract arguments from instances of Inequality. Following doesn't work, any idea why and how to fix it?
Inequality[1, Less, x, Less, 2] /. Inequality[a_, _, c_, _, e_] -> {a, c, e}
Inequality[1,Less,x,Less,2] /. HoldPattern[Inequality[a_,_,b_,_,c_]] -> {a, b, c}
Out: {1, x, 2}
Also, you can do this:
Inequality[1, Less, x, Less, 2] /.
Literal # Inequality[ a_ , _ , c_ , _ , e_ ] -> {a, c, e}
ADL
Why don't you use standard access to subexpression?
expr = Inequality[1, Less, x, Less, 2];
{a,c,e} = {expr[[1]], expr[[3]], expr[[5]]};
I'm currently doing some normalization along the lines of:
J = Integrate[Psi[x, 0]^2, {x, 0, a}]
sol = Solve[J == 1, A]
A /. sol
For this type of normalization, the negative square root is extraneous. The result of this calculation is:
In[49]:= J = Integrate[Psi[x, 0]^2, {x, 0, a}]
Out[49]= 2 A^2
In[68]:= sol = Solve[J == 1, A]
Out[68]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
Even if I try giving it an Assuming[...] or Simplify[...], it still gives me the same results:
In[69]:= sol = Assuming[A > 0, Solve[J == 1, A]]
Out[69]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
In[70]:= sol = FullSimplify[Solve[J == 1, A], A > 0]
Out[70]= {{A -> -(1/Sqrt[2])}, {A -> 1/Sqrt[2]}}
Can anyone tell me what I'm doing wrong here?
I'm running Mathematica 7 on Windows 7 64-bit.
ToRules does what the box says: converts equations (as in Reduce output) to rules. In your case:
In[1]:= ToRules[Reduce[{x^2==1,x>0},x]]
Out[1]= {x->1}
In[2]:= {ToRules[Reduce[{x^2==1},x]]}
Out[2]= {{x->-1},{x->1}}
For more complex cases, I have often found it useful to just check the value of the symbolic solutions after pluging in typical parameter values. This is not foolproof, of course, but if you know there is one and only one solution then it is a simple and efficient method:
Solve[x^2==someparameter,x]
Select[%,((x/.#)/.{someparameter-> 0.1})>0&]
Out[3]= {{x->-Sqrt[someparameter]},{x->Sqrt[someparameter]}}
Out[4]= {{x->Sqrt[someparameter]}}
Solve doesn't work like this. You might try Reduce, instead, e.g.
In[1]:= Reduce[{x^2 == 1, x > 0}, x]
Out[1]= x == 1
It's then a little tricky to transform this output to replacement rules, at least in the general case, because Reduce might use arbitrary many logical connectives. In this case, we could just hack:
In[2]:= Solve[Reduce[{x^2 == 1, x > 0}, x], x]
Out[2]= {{x->1}}