Mathematica NonlinearModelFit strange output [closed] - wolfram-mathematica

Closed. This question is off-topic. It is not currently accepting answers.
Want to improve this question? Update the question so it's on-topic for Stack Overflow.
Closed 10 years ago.
Improve this question
I am trying to run NonlinearModelFit in mathematica on some data for a project. It is a fairly complicated model having 9 coefficients, and 5 independent variables. I created the data the way that the model needs, and I think I called the function correctly.
Here is a sample of the data:
{{16.5892, 0.631, 1.7707, 1258.21, 580.271, 14.02}, {16.2855, 0.813,
1.76756, 2098.41, 745.624, 13.59}, {16.036, 0.58, 1.77311, 846.994, 718.092, 13.41}}
Of course the total amount of data is about 30 data sets for the function to use.
Here is my function call:
nlm = NonlinearModelFit[data, a + c*b + d*bminv + e*M + f*bminv*M + g*x + h*x^2 + i*y + j*y^2,
{a, c, d, e, f, g, h, i, j}, {b, bminv, M, x, y}];
I think that this should work, but I get a really weird output:
FittedModel[38592.8+0.811612b+<<9>>+3.06099*10^-7*y^2]^3
The numbers for this model might be right, but I do not understand the part with <<9>>, and even more so I do not understand how the FittedModel function, which is what NonlinearModelFit always returns, is cubed.
Besides the weirdness of the output, it is also an unusuable output, I have tried functions that should work with FittedModel objects, and none of them work.
If anybody has some advice as to what the output means, how to fix it, or if I am simply doing something wrong with my function call or data it would be much appreciated.
Thanks.

It seems to work and I don't get the ^3 :
data = {{16.5892, 0.631, 1.7707, 1258.21, 580.271, 14.02}, {16.2855, 0.813, 1.76756, 2098.41, 745.624, 13.59}, {16.036, 0.58, 1.77311, 846.994, 718.092, 13.41}}
nlm = NonlinearModelFit[data, a + c*b + d*bminv + e*M + f*bminv*M + g*x + h*x^2 + i*y + j*y^2, {a, c, d, e, f, g, h, i, j}, {b, bminv, M, x, y}] ;
nlm[Sequence ## Most[#]] & /# data - data[[All, -1]]
(* {-1.77636*10^-15, 0., -3.55271*10^-15} *)

Related

A Prolog predicate result [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Closed 9 years ago.
Improve this question
I have written a Prolog relation remove(E,L,R) that is true if R is the list which results from removing one instance of E from list L. The relation is false if E isn't a member of L.
I want to know the result of the following query
remove(p(X),[a,p(a),p(p(a)),p(p(p(a)))],R).
So? Just ask. Not us, but ask Prolog. The result should be
?- remove(p(X),[a,p(a),p(p(a)),p(p(p(a)))],R).
X = a,
R = [a, p(p(a)), p(p(p(a)))]
or something along those lines, if you've written it right. If you allow backtracking (in other words, removing an element from your list, starting with the first), you'll get something like
?- remove(p(X),[a,p(a),p(p(a)),p(p(p(a)))],R).
X = a,
R = [a, p(p(a)), p(p(p(a)))] ;
X = p(a),
R = [a, p(a), p(p(p(a)))] ;
X = p(p(a)),
R = [a, p(a), p(p(a))] ;
false.

Mathematica, solving non linear system of equations with lot of equations and variables

I need to find a square matrix A satisfying the equation
A.L.A = -17/18A -2(A.L.L + L.A.L + (L.L).A) + 3(A.L + L.A) -4L.L.L + 8L.L - 44/9L + 8/9*(ID)
,where L is a diagonal matrix L = {{2/3,0,0,0},{0,5/12,0,0},{0,0,11/12,0},{0,0,0,2/3}}.
I can find the answers in the case that A is of dimension 2 and 3, but there is a problem with dimension 4 and above.
Actually, the matrix A has to satisfy the equation A.A = A too, but with a suitable matrix L only the equation above equation is enough.
This is my code ;
A = Table[a[i,j],{i,1,4},{j,1,4}]
B = A.L.A
ID = IdentityMatrix[4]
M = -17/18A -2(A.L.L + L.A.L + (L.L).A) + 3(A.L + L.A) -4L.L.L + 8L.L - 44/9L + 8/9*(ID)
diff = (B - M)//ExpandAll//Flatten ( so I get 16 non linear system of equations here )
A1 = A/.Solve[diff == 0][[1]]
After running this code for quite sometime, the error come up with there is not enough memory to compute.
In this case there are 16 equations and 16 variables. Some of the entries are parameters but I just do not know which one until I get the result.
I am not sure if there is anyway to solve this problem. I need the answer to be rational(probably integers) which is possible theoretically.
Could this problem be solved by matrix equation or any other method? I see one problem for this is there are too many equations and variables.
This evaluates fairly quickly and with modest memory for a problem this size.
L = {{2/3, 0, 0, 0}, {0, 5/12, 0, 0}, {0, 0, 11/12, 0}, {0, 0, 0, 2/3}};
A = {{a, b, c, d}, {e, f, g, h}, {i, j, k, l}, {m, n, o, p}};
Reduce[{A.L.A == -17/18 A - 2 (A.L.L + L.A.L + (L.L).A) + 3 (A.L + L.A) -
4 L.L.L + 8 L.L - 44/9 L + 8/9*IdentityMatrix[4]},
{a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p}, Backsubstitution->True
]
Then you just have to sort through the 143 potential solutions that it returns.
You might be able to Select from those that satisfy your A.A==A. You can also use ToRules on the result returned from Reduce to put this into a form similar to that returned from Solve, but check this carefully to make certain it is doing what you expect.
Check this very carefully to make certain I haven't made any mistakes.

How to preserve results from Maximize in Mathematica?

I aim to calculate and preserve the results from the maximization of a function with two arguments and one exogenous parameter, when the maximum can not be derived (in closed form) by maximize. For instance, let
f[x_,y_,a_]=Max[0,Min[a-y,1-x-y]
be the objective function where a is positive. The maximization shall take place over [0,1]^2, therefore I set
m[a_]=Maximize[{f[x, y, a], 0 <= x <= 1 && 0 <= y <= 1 && 0 <= a}, {x,y}]
Obviously m can be evaluated at any point a and it is therefore possible to plot the maximizing x by employing
Plot[x /. m[a][[2]], {a, 0.01, 1}]
As I need to do several plots and further derivations containing the optimal solutions x and y (which of course are functions of a), i would like to preserve/save the results from the optimization for further use. Is there an elegant way to do this, or do I have to write some kind of loop to extract the values myself?
Now that I've seen the full text of your comment on my original comment, I suspect that you do understand the differences between Set and SetDelayed well enough. I think what you may be looking for is memoisation, sometimes implemented a bit like this;
f[x_,y_] := f[x,y] = Max[0,Min[a-y,1-x-y]]
When you evaluate, for example f[3,4] for the first time it will evaluate to the entire expression to the right of the :=. The rhs is the assignment f[3,4] = Max[0,Min[a-y,1-x-y]]. Next time you evaluate f[3,4] Mathematica already has a value for it so doesn't need to recompute it, it just recalls it. In this example the stored value would be Max[0,Min[a-4,-6]] of course.
I remain a little uncertain of what you are trying to do so this answer may not be any use to you at all.
Simple approach
results = Table[{x, y, a} /. m[a][[2]], {a, 0.01, 1, .01}]
ListPlot[{#[[3]], #[[1]]} & /# results, Joined -> True]
(The Set = is ok here so long as 'a' is not previosly defined )
If you want to utilise Plot[]s automatic evaluation take a look at Reap[]/Sow[]
{p, data} = Reap[Plot[x /. Sow[m[a]][[2]], {a, 0.01, 1}]];
Show[p]
(this takes a few minutes as the function output is a mess..).
hmm try this again: assuming you want x,y,a and the minimum value:
{p, data} = Reap[Plot[x /. Sow[{a, m[a]}][[2, 2]], {a, 0.01, .1}]];
Show[p]
results = {#[[1]], x /. #[[2, 2]], y /. #[[2, 2]], #[[2, 1]]} & /# data[[1]]
BTW Your function appears to be independent of x over some ranges which is why the plot is a mess..

Solve with Simplify yields Real Solution and Solve with FullSimplify a Complex Solution? [closed]

Closed. This question is off-topic. It is not currently accepting answers.
Want to improve this question? Update the question so it's on-topic for Stack Overflow.
Closed 10 years ago.
Improve this question
I have a problem with the DSolve[] command in mathematica 8. Solving the the following 4th order differential equation spits out a complex solution although it should be a real one.
The equation is:
y''''[x] + a y[x] == 0
Solving this equation by hand yields a solution with only real parts. All constants and boundary conditions are also real numbers.
The solution I get by hand is:
y1[x_] = (C[5] E^(Power[a, (4)^-1]/Power[2, (2)^-1] x) +
C[6] E^(-(Power[a, (4)^-1]/Power[2, (2)^-1]) x)) Cos[
Power[a, (4)^-1]/Power[2, (2)^-1]
x] + (C[7] E^(Power[a, (4)^-1]/Power[2, (2)^-1] x) +
C[8] E^(-(Power[a, (4)^-1]/Power[2, (2)^-1]) x)) Sin[
Power[a, (4)^-1]/Power[2, (2)^-1] x];
Now I have to solve for the constants C[5]...C[8]. This arises a similar issue. I use the Solve[] command with the boundary conditions
Solve[{y1''[-c] == ic0, y1''[c] == ic0 , y1'''[-c] == ic1 ,
y1'''[c] == - ic1 }, {C[5], C[6], C[7], C[8]} ];
The constants C[5]...C[8] are now real if using //Simplify and complex if using //FullSimplify.
Any idea what the reasons are?
The notebook with my calculations can be downloaded under:
http://dl.dropbox.com/u/4920002/DGL_4th_Order_with_own_solution.nb
In further work I have to use DSolve[] and I would like to understand the issue here.
Thanks,
Andreas
I think that some of your statements depend on the details. For instance some of the parameters C[] can be complex numbers if you choose a<0 :
parS = Solve[{y1''[-c] == ic0, y1''[c] == ic0, y1'''[-c] == ic1,
y1'''[c] == -ic1}, {C[5], C[6], C[7], C[8]}] // Simplify;
parFS = Solve[{y1''[-c] == ic0, y1''[c] == ic0, y1'''[-c] == ic1,
y1'''[c] == -ic1}, {C[5], C[6], C[7], C[8]}] // FullSimplify
parS /. {a -> -2, c -> 10, ic0 -> 1, ic1 -> -1} // N
parFS /. {a -> -2, c -> 10, ic0 -> 1, ic1 -> -1} // N
(* {{C[5] -> -0.35876 - 2.498*10^-15 I, C[6] -> -0.35876 - 2.498*10^-15 I,
C[7] -> 2.27596*10^-15 - 0.358762 I, C[8] -> -2.27596*10^-15 + 0.358762 I}}
{{C[5] -> -0.35876 + 5.10703*10^-15 I, C[6] -> -0.35876 + 5.10703*10^-15 I,
C[7] -> 2.35922*10^-15 - 0.358762 I, C[8] -> -2.19269*10^-15 + 0.358762 I}} *)
Besides this point you can get the solution to your problem in one line and indeed it seems a real function (apart from numerics) :
sol[a_, ic0_, ic1_, c_, x_] = y[x] /. DSolve[{y''''[x] + a y[x] == 0, y''[-c] == ic0,
y''[c] == ic0, y'''[-c] == ic1, y'''[c] == -ic1}, y[x], x][[1]] ;
Plot[Im[sol[-2.0, 1.0, -1.0, 10., x]], {x, -10., 10.}]
Plot[Re[sol[-2.0, 1.0, -1.0, 10., x]], {x, -10., 10.}]
Since you cross-posted the question to Mathematica.SE, I gave an answer there. The crux of it is that even with a real and positive value for a, the general solution to your fourth-order differential equation is complex. Period. If you happen to be only interested in the real solutions, it is possible to extract them.

Trying to get Mathematica to approximate an integral

I am trying to get Mathematica to approximate an integral that is a function of various parameters. I don't need it to be extremely precise -- the answer will be a fraction, and 5 digits would be nice, but I'd settle for as few as 2.
The problem is that there is a symbolic integral buried in the main integral, and I can't use NIntegrate on it since its symbolic.
F[x_, c_] := (1 - (1 - x)^c)^c;
a[n_, c_, x_] := F[a[n - 1, c, x], c];
a[0, c_, x_] = x;
MyIntegral[n_,c_] :=
NIntegrate[Integrate[(D[a[n,c,y],y]*y)/(1-a[n,c,x]),{y,x,1}],{x,0,1}]
Mathematica starts hanging when n is greater than 2 and c is greater than 3 or so (generally as both n and c get a little higher).
Are there any tricks for rewriting this expression so that it can be evaluated more easily? I've played with different WorkingPrecision and AccuracyGoal and PrecisionGoal options on the outer NIntegrate, but none of that helps the inner integral, which is where the problem is. In fact, for the higher values of n and c, I can't even get Mathematica to expand the inner derivative, i.e.
Expand[D[a[4,6,y],y]]
hangs.
I am using Mathematica 8 for Students.
If anyone has any tips for how I can get M. to approximate this, I would appreciate it.
Since you only want a numerical output (or that's what you'll get anyway), you can convert the symbolic integration into a numerical one using just NIntegrate as follows:
Clear[a,myIntegral]
a[n_Integer?Positive, c_Integer?Positive, x_] :=
a[n, c, x] = (1 - (1 - a[n - 1, c, x])^c)^c;
a[0, c_Integer, x_] = x;
myIntegral[n_, c_] :=
NIntegrate[D[a[n, c, y], y]*y/(1 - a[n, c, x]), {x, 0, 1}, {y, x, 1},
WorkingPrecision -> 200, PrecisionGoal -> 5]
This is much faster than performing the integration symbolically. Here's a comparison:
yoda:
myIntegral[2,2]//Timing
Out[1]= {0.088441, 0.647376595...}
myIntegral[5,2]//Timing
Out[2]= {1.10486, 0.587502888...}
rcollyer:
MyIntegral[2,2]//Timing
Out[3]= {1.0029, 0.647376}
MyIntegral[5,2]//Timing
Out[4]= {27.1697, 0.587503006...}
(* Obtained with WorkingPrecision->500, PrecisionGoal->5, MaxRecursion->20 *)
Jand's function has timings similar to rcollyer's. Of course, as you increase n, you will have to increase your WorkingPrecision way higher than this, as you've experienced in your previous question. Since you said you only need about 5 digits of precision, I've explicitly set PrecisionGoal to 5. You can change this as per your needs.
To codify the comments, I'd try the following. First, to eliminate infinite recursion with regards to the variable, n, I'd rewrite your functions as
F[x_, c_] := (1 - (1-x)^c)^c;
(* see note below *)
a[n_Integer?Positive, c_, x_] := F[a[n - 1, c, x], c];
a[0, c_, x_] = x;
that way n==0 will actually be a stopping point. The ?Positive form is a PatternTest, and useful for applying additional conditions to the parameters. I suspect the issue is that NIntegrate is re-evaluating the inner Integrate for every value of x, so I'd pull that evaluation out, like
MyIntegral[n_,c_] :=
With[{ int = Integrate[(D[a[n,c,y],y]*y)/(1-a[n,c,x]),{y,x,1}] },
NIntegrate[int,{x,0,1}]
]
where With is one of several scoping constructs specifically for creating local constants.
Your comments indicate that the inner integral takes a long time, have you tried simplifying the integrand as it is a derivative of a times a function of a? It seems like the result of a chain rule expansion to me.
Note: as per Yoda's suggestion in the comments, you can add a cacheing, or memoization, mechanism to a. Change its definition to
d:a[n_Integer?Positive, c_, x_] := d = F[a[n - 1, c, x], c];
The trick here is that in d:a[ ... ], d is a named pattern that is used again in d = F[...] cacheing the value of a for those particular parameter values.

Resources