Cómo ajustar parámetros en un sistema de ecuaciones diferenciales acopladas

Después de de una larga selección de información resolvimos este atolladero que suelen tener algunos los usuarios. Te regalamos la respuesta y esperamos servirte de gran apoyo.

Solución:

Solo quería señalar que todas las rutas anteriores funcionarán si solo hay una ecuación diferencial:

data = NDSolveValue[
     x''[t] - k1*(1 - x[t]^2)*x'[t] + k2*x[t] == 0, 
     x[0] == 2, x'[0] == 0 /. k1 -> 1., k2 -> 1., 
   Table[t, x[t] + RandomReal[-.3, .3], t, 0, 10, .2], t, 10];
dataT = data[Transpose];
ti = dataT[[1, All]];
di = dataT[[2, All]];
pfun = ParametricNDSolveValue[
    x''[t] - k1*(1 - x[t]^2)*x'[t] + k2*x[t] == 0,
    x[0] == 2, x'[0] == 0,
    x, t, 0, 10, k1, k2];

FindFit encuentra los parámetros de mejor ajuste con éxito:

fit = FindFit[data, pfun[k1, k2][t], k1, 2, k2, 0, t]
Out[1]= k1 -> 1.09028, k2 -> 1.02729

FindMinimum también los encuentra:

FindMinimum[Total[(di - Map[pfun[k1, k2], ti])^2], k1, k2]
Out[2]= 1.41041, k1 -> 1.09028, k2 -> 1.02729

Y el Module enfoque también produjo el mismo resultado:

objfun[k_] := Module[,
  fun = NDSolveValue[
     x''[t] - k[[1]]*(1 - x[t]^2)*x'[t] + k[[2]]*x[t] == 0,
     x[0] == 2, x'[0] == 0,
    x, t, 0, 10];
  Total[(di - Map[fun, ti])^2]
  ]
FindMinimum[objfun[k1, k2], k1, 1.0, k2, 0.0]
Out[3]= 1.41041, k1 -> 1.09028, k2 -> 1.02729

Defina esta función:

f[k1_?NumericQ, k2_?NumericQ, k3_?NumericQ] := 
 Sum[Total[(ci[[i, All]] - Map[pfun[k1, k2, k3][[i]], ti])^2], i, 1, 3] // Quiet

Después,

fit = NMinimize[f[k1, k2, k3], k1, k2, k3];
params = fit // Last
(*k1 -> 0.000194805, k2 -> 0.0291469, k3 -> 0.109229*)

plotearlo,

Table[Show[
  ListPlot[Transpose[ti, ci[[i]]]],
  Plot[(pfun[k1, k2, k3] /.params)[[i]][t], t, ti[[1]], ti // Last
   ]], i, 1, 3]

Nos puedes respaldar nuestro quehacer poniendo un comentario o dejando una valoración te estamos eternamente agradecidos.

---

---

Utiliza Nuestro Buscador