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]]};
Related
I`ve seen several answers for quite similar topics with usage of ?NumericQ explained and still can not quite understand what is wrong with my implementation and could my example be evaluated at all the way I want it.
I have solution of differential equation in form of ParametricNDSolve (I believe that exact form of equation is irrelevant):
sol = ParametricNDSolve[{n'[t] == g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2, n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
After that I am trying to construct a function for FindFit or similar procedure, Nintegrating over function n[a,b,c,g,f,y,t] I have got above with some multiplier (I have chosen Log[z] as multiplier for simplicity)
Func[z_, a_, b_, c_, g_, f_] :=
NIntegrate[
Log[z]*(n[a, b, c, g, f, y][t] /. sol), {t, 0, 10}, {y, 0, Log[z]}]
So I have NIntegrate over my function n[params,t] derived from ParametricNDSolve with multiplier introducing new variable (z) wich also present in the limits of integration (in the same form as in multiplier for simplicity of example)
I am able to evaluate the values of my function Func at any point (z) with given values of parameters (a,b,c,g,f): Func(0,1,2,3,4,5) could be evaluated.
But for some reasons I cannot use FindFit like that:
FindFit[data, Func[z, a, b, c, g, f], {a, b, c, g, f}, z]
The error is: NIntegrate::nlim: y = Log[z] is not a valid limit of integration.
I`ve tried a lot of different combinations of ?NumericQ usage and all seems to lead nowhere. Any help would be appreciated!
Thanks in advance and sorry for pure english in the problem explanation.
Here is a way to define your function:
sol = n /.
ParametricNDSolve[{n'[t] ==
g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2,
n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
Func[z_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ, g_?NumericQ,
f_?NumericQ] :=
NIntegrate[Log[z]*sol[a, b, c, g, f, y][t],
{t, 0, 10}, {y, 0, Log[z]}]
test: Func[2, .45, .5, .13, .12, .2] -> 0.106107
I'm not optimistic you will get good results from FindFit with a function with so many parameters and which is so computationally expensive.
I am very new to Mathematica, and I am trying to solve the following problem.
I have a cubic equation of the form Z = aZ^3 + bZ^2 + a + b. The first thing I want to do is to get a function that solves this analytically for Z and chooses the minimal positive root for that, as a function of a and b.
I thought that in order to get the root I could use:
Z = Solve[z == az^3 + bz^2 + a + b, z];
It seems like I am not quite getting the roots, as I would expect using the general cubic equation solution formula.
I want to integrate the minimal positive root of Z over a and b (again, preferably analytically) from 0 to 1 for a and for a to 1 for b.
I tried
Y = Integrate[Z, {a, 0, 1}, {b, a, 1}];
and that does not seem to give any formula or numerical value, but just returns an integral. (Notice I am not even sure how to pick the minimal positive root, but I am playing around with Mathematica to try to figure it out.)
Any ideas on how to do this?
Spaces between a or b and z are important. You can get the roots by:
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z]
However, are you sure this expression has a solution as you expect? For a=0.5 and b=0.5, the only real root is negative.
sol /. {a->0.5, b->0.5}
{-2.26953,0.634765-0.691601 I,0.634765+0.691601 I}
sol = z /. Solve[z == a z^3 + b z^2 + a + b, z];
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ sol /. {a -> a0, b -> b0} ,
Element[#, Reals] && # > 0 & ]]
This returns -infinty when there are no solutions. As sirintinga noted your example integration limits are not valid..
RegionPlot[NumericQ[zz[a, b] ] , {a, -1, .5}, {b, -.5, 1}]
but you can numerically integrate if you have a valid region..
NIntegrate[zz[a, b], {a, -.5, -.2}, {b, .8, .9}] ->> 0.0370076
Edit ---
there is a bug above Select in Reals is throwin away real solutions with an infinitesimal complex part.. fix as:..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Min[Select[ Chop[ sol /. {a -> a0, b -> b0} ],
Element[#, Reals] && # > 0 & ]]
Edit2, a cleaner approach if you dont find Chop satisfyting..
zz[a0_ /; NumericQ[a0], b0_ /; NumericQ[b0]] :=
Module[{z, a, b},
Min[z /. Solve[
Reduce[(z > 0 && z == a z^3 + b z^2 + a + b /.
{ a -> a0, b -> b0}), {z}, Reals]]]]
RegionPlot[NumericQ[zz[a, b] ] , {a, -2, 2}, {b, -2, 2}]
NIntegrate[zz[a, b], {a, 0, .5}, {b, 0, .5 - a}] -> 0.0491321
I have here a complicated bit of code that is not pretty nor easy to follow, but it represents a simplification of a larger body of code I am working with. I am a Mathematica novice and have already received some help on this issue from stackoverflow but it is still not solving my problem. Here is the code for which I hope you can follow along and assume what I am trying to get it to do. Thanks to you programming whizzes for the help.
a[b_, c_] = -3*b + 2*c + d + e + f;
g[b_, c_] := If[a[b, c] < 0, -3*a[b, c], a[b, c]];
h[T_, b_, c_] = (T/g[b, c]);
i[h_, T_, b_, c_] := If[h[T, b, c] > 0, 4*h[T, b, c], -5*h[T, b, c]];
j[b_, c_] := If[a[b, c] < 0, 5*a[b, c], 20*a[b, c]];
XYZ[h_, T_, i_, g_, j_, b_, c_] = T*i[h, T, b, c]*g[b, c] + j[b, c]
rules = {a -> 1, b -> 2, c -> 3, d -> 4, e -> 5, f -> 6, T -> 10};
XYZ[h, T, i, g, j, b, c] //. rules
Preserving as much of your code as possible, it will work with just a few changes:
a[b_, c_] := -3*b + 2*c + d + e + f;
g[b_, c_] := If[# < 0, -3 #, #] & # a[b, c]
h[T_, b_, c_] := T / g[b, c]
i[h_, T_, b_, c_] := If[# > 0, 4 #, -5 #] & # h[T, b, c]
j[b_, c_] := If[# < 0, 5 #, 20 #] & # a[b, c]
XYZ[h_, T_, i_, g_, j_, b_, c_] := T*i[h, T, b, c]*g[b, c] + j[b, c]
rules = {a -> 1, b -> 2, c -> 3, d -> 4, e -> 5, f -> 6, T -> 10};
XYZ[h, T, i, g, j, b, c] /. rules
(* Out= 700 *)
If statements are again externalized, as in the last problem.
all definitions are made with SetDelayed (:=), as a matter of good practice.
The presumed error T - 10 in your rules is corrected to T -> 10
Notice that again ReplaceRepeated (//.) is not needed, and is changed to /.
We still have a nonsensical rule a -> 1 but it does not cause a failure.
Say I have a list of Rules
rules = {a -> b, c -> d};
which I use throughout a notebook. Then, at one point, it makes sense to want the rules to apply before any other evaluations take place in an expression. Normally if you want something like this you would use
In[2]:= With[{a=b,c=d}, expr[a,b,c,d]]
Out[2]= expr[b, b, d, d]
How can I take rules and insert it into the first argument of With?
Edit
BothSome solutions fail do all that I was looking for - but I should have emphasised this point a little more. See the bold part above.
For example, let's look at
rules = {a -> {1, 2}, c -> 1};
If I use these vaules in With, I get
In[10]:= With[{a={1,2},c=1}, Head/#{a,c}]
Out[10]= {List,Integer}
Some versions of WithRules yield
In[11]:= WithRules[rules, Head/#{a,c}]
Out[11]= {Symbol, Symbol}
(Actually, I didn't notice that Andrew's answer had the Attribute HoldRest - so it works just like I wanted.)
You want to use Hold to build up your With statement. Here is one way; there may be a simpler:
In[1]:= SetAttributes[WithRules, HoldRest]
In[2]:= WithRules[rules_, expr_] :=
With ## Append[Apply[Set, Hold#rules, {2}], Unevaluated[expr]]
Test it out:
In[3]:= f[args___] := Print[{args}]
In[4]:= rules = {a -> b, c -> d};
In[5]:= WithRules[rules, f[a, c]]
During evaluation of In[5]:= {b,d}
(I used Print so that any bug involving me accidentally evaluating expr too early would be made obvious.)
I have been using the following form of WithRules for a long time. Compared to the one posted by Andrew Moylan, it binds sequentially so that you can say e.g. WithRules[{a->b+1, b->2},expr] and get a expanded to 3:
SetAttributes[WithRules, HoldRest]
WithRules[rules_, expr_] := ReleaseHold#Module[{notSet}, Quiet[
With[{args = Reverse[rules /. Rule[a_, b_] -> notSet[a, b]]},
Fold[With[{#2}, #1] &, Hold#expr, args]] /. notSet -> Set,
With::lvw]]
This was also posted as an answer to an unrelated question, and as noted there, it has been discussed (at least) a couple of times on usenet:
A version of With that binds variables sequentially
Add syntax highlighting to own command
HTH
EDIT: Added a ReleaseHold, Hold pair to keep expr unevaluated until the rules have been applied.
One problem with Andrew's solution is that it maps the problem back to With, and that does not accept subscripted variables. So the following generates messages.
WithRules[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Power[Subscript[x, 1], Subscript[x, 2]]]
Given that With performs syntactic replacement on its body, we can set WithRules alternatively as follows:
ClearAll[WithRules]; SetAttributes[WithRules, HoldRest];
WithRules[r : {(_Rule | _RuleDelayed) ..}, body_] :=
ReleaseHold[Hold[body] /. r]
Then
In[113]:= WithRules[{Subscript[x, 1] -> 2,
Subscript[x, 2] -> 3}, Subscript[x, 1]^Subscript[x, 2]]
Out[113]= 8
Edit: Addressing valid concerns raised by Leonid, the following version would be safe:
ClearAll[WithRules3]; SetAttributes[WithRules3, HoldRest];
WithRules3[r : {(_Rule | _RuleDelayed) ..}, body_] :=
Developer`ReplaceAllUnheld[Unevaluated[body], r]
Then
In[194]:= WithRules3[{Subscript[x, 1] -> 2, Subscript[x, 2] -> 3},
Subscript[x, 1]^Subscript[x, 2]]
Out[194]= 8
In[195]:= WithRules3[{x -> y}, f[y_] :> Function[x, x + y]]
Out[195]= f[y_] :> Function[x, x + y]
Edit 2: Even WithRules3 is not completely equivalent to Andrew's version:
In[206]:= WithRules3[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[206]= f[y_] :> Function[x, x + y + z]
In[207]:= WithRules[{z -> 2}, f[y_] :> Function[x, x + y + z]]
Out[207]= f[y$_] :> Function[x$, x$ + y$ + 2]
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