Skip to main content

differential equations - How to adjust parameters to experimental data on a NDSolve problem


I have 2 differential equations with 2 variables, x and y,which are a function of t and I have the parameters k1, k2 y k3.


                       dx/dt=-k1 x2+ k2 x y
dy/dt=k1 x2-k2 x y- k3 y

I have to adjust the equations to the following experimental data


                       xo=70.26, x(t=720)=45.78
xo=71.04, x(t=720)=46.32
xo=37.23, x(t=720)=24.67

xo=37.91, x(t=720)=28.78

I tried FindFit and NMinimize. The problem with FindFit is that I have multiple initial conditions. Then I used NMinimize, I tried to create a function error only with the first data (eventually, I will use the rest of the data) but NMinimize gives me the following error This is the funtion.


Remove["Global`*"] 
f[k1_?NumericQ,k2_?NumericQ,k3_?NumericQ]:=
Module[{x,y,out},out=Abs[45.78-x[720] /.
NDSolve[{x'[t]==-k1 x[t]^2+k2 x[t]y[t],y'[t]==k1 x[t]^2-k2 x[t]y[t]-k3 y[t],
x[0]==70.26,y[0]==0},{x,y},{t,0,800}]]]
res=NMinimize[{f},{k1,k2,k3}]


And this is the error



NMinimize::nnum: The function value f is not a number at {k1,k2,k3} = {8.17269,8.09533,4.9417}. >>



If anybody can help



Answer



Could be interpreted as a nonlinear least squares problem.


pts = {{70.26, 45.78}, {71.04, 46.32}, {37.23, 24.67}, {37.91, 
28.78}};


ndsoln[{k1_, k2_, k3_}, x0_] := x[720] /.
NDSolve[{x'[t] == -k1 x[t]^2 + k2 x[t] y[t],
y'[t] == k1 x[t]^2 - k2 x[t] y[t] - k3 y[t], x[0] == x0,
y[0] == 0}, {x, y}, {t, 0, 720}][[1]]

ssfun[{k1_?NumericQ, k2_?NumericQ, k3_?NumericQ}] :=
Sum[(ndsoln[{k1, k2, k3}, pts[[i, 1]]] - pts[[i, 2]])^2,
{i, Length[pts]}]

scaledArgs = {10^-5 k1, k2, 10^2 k3};


fm = FindMinimum[ssfun[scaledArgs], {k1, 3, 4}, {k2, 20, 21}, {k3, 5, 6}]

Show[Plot[ndsoln[scaledArgs /. fm[[2]], x0], {x0, 35, 75}],
ListPlot[pts, PlotStyle -> Directive[ColorData[1][2], PointSize[Medium]]],
PlotRange -> {20, 50}, Frame -> False, Axes -> True,
AxesLabel -> {"x(0)", "x(720)"}, AxesOrigin -> {35, 20}]

The result


Comments

Popular posts from this blog

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...

dynamic - How can I make a clickable ArrayPlot that returns input?

I would like to create a dynamic ArrayPlot so that the rectangles, when clicked, provide the input. Can I use ArrayPlot for this? Or is there something else I should have to use? Answer ArrayPlot is much more than just a simple array like Grid : it represents a ranged 2D dataset, and its visualization can be finetuned by options like DataReversed and DataRange . These features make it quite complicated to reproduce the same layout and order with Grid . Here I offer AnnotatedArrayPlot which comes in handy when your dataset is more than just a flat 2D array. The dynamic interface allows highlighting individual cells and possibly interacting with them. AnnotatedArrayPlot works the same way as ArrayPlot and accepts the same options plus Enabled , HighlightCoordinates , HighlightStyle and HighlightElementFunction . data = {{Missing["HasSomeMoreData"], GrayLevel[ 1], {RGBColor[0, 1, 1], RGBColor[0, 0, 1], GrayLevel[1]}, RGBColor[0, 1, 0]}, {GrayLevel[0], GrayLevel...

functions - What best practices or performance considerations are there for choosing between Cases, Position, Pick and Select?

Cases , Select , Pick and Position each have different syntaxes and purposes, but there are times when you can express the same calculation equivalently using either of them. So with this input: test = RandomInteger[{-25, 25}, {20, 2}] {{-15, 13}, {-8, 16}, {-8, -19}, {7, 6}, {-21, 9}, {-3, -25}, {21, -18}, {4, 4}, {2, -2}, {-24, 8}, {-17, -8}, {4, -18}, {22, -24}, {-4, -3}, {21, 0}, {19, 18}, {-23, -8}, {23, -25}, {14, -2}, {-1, -13}} You can get the following equivalent results: Cases[test, {_, _?Positive}] {{-15, 13}, {-8, 16}, {7, 6}, {-21, 9}, {4, 4}, {-24, 8}, {19, 18}} Select[test, #[[2]] > 0 &] {{-15, 13}, {-8, 16}, {7, 6}, {-21, 9}, {4, 4}, {-24, 8}, {19, 18}} Pick[test, Sign[test[[All, 2]] ], 1] {{-15, 13}, {-8, 16}, {7, 6}, {-21, 9}, {4, 4}, {-24, 8}, {19, 18}} test[[Flatten@Position[test[[All, 2]], _?Positive] ]] {{-15, 13}, {-8, 16}, {7, 6}, {-21, 9}, {4, 4}, {-24, 8}, {19, 18}} Are there performance or other considerations that should guide which you shou...