Недостаток памяти Mathematica при подборе параметров системы дифференциальных уравнений - PullRequest
Новая
       11

Недостаток памяти Mathematica при подборе параметров системы дифференциальных уравнений

2 голосов
/ 29 ноября 2011

Я столкнулся с проблемой памяти в Mathematica, когда попытался обработать свои экспериментальные данные.Я использую Mathematica, чтобы найти оптимальные параметры для системы из трех уравнений в частных производных.

Когда параметр e был больше 0,4, Mathematica потребляла много памяти.Для e < 0.4 программа работала правильно.

Я пытался использовать $HistoryLength = 0, и безрезультатно AccuracyGoal и WorkingPrecision.

Я пытаюсь понять, чтоошибки, которые я сделал, и как я могу ограничить использование памяти. 

Clear[T, L, e, v, q, C0, R, data, model];
T = 13200; 
L = 0.085; 
e = 0.41; 
v = 0.000557197; 
q = 0.1618; 
C0 = 0.0256; 
R = 0.00075;

data = {{L, 600, 0.141124587}, {L, 1200, 0.254134509}, {L, 1800, 
    0.342888644}, {L, 2400, 0.424476295}, {L, 3600, 0.562844542}, {L, 
    4800, 0.657111356}, {L, 6000, 0.75137817}, 
       {L, 7200, 0.815876516}, {L, 8430, 0.879823594}, {L, 9000, 
    0.900771775}, {L, 13200, 1}};

model[(De_)?NumberQ, (Kf_)?NumberQ, (Y_)?NumberQ] := 
 model[De, Kf, Y] =  yeld /. Last[Last[
     NDSolve[{
       v D[Ci[z, t], z] + D[Ci[z, t], t] == -((
         3 (1 - e) Kf (Ci[z, t] - C0))/(
         R e (1 - (R Kf (1 - R/r[z, t]))/De))),
       D[r[z, t], t] == (R^2 Kf (Ci[z, t] - C0))/(
        q r[z, t]^2 (1 - (R Kf (1 - R/r[z, t]))/De)),
       D[yeld[z, t], t] == Y*(v e Ci[z, t])/(L q (1 - e)),
       r[z, 0] == R,
       Ci[z, 0] == 0,
       Ci[0, t] == 0,
       yeld[z, 0] == 0},
      {r[z, t], Ci[z, t], yeld}, {z, 0, L}, {t, 0, T}]]]

fit = FindFit[
  data, {model[De, Kf, Y][z, t], {0.97  < Y < 1.03, 
    10^-6 < Kf < 10^-4, 10^-13 < De < 10^-9}}, 
     {{De, 10^-12}, {Kf,  10^-6}, {Y, 1}}, {z, t}, Method -> NMinimize]

data = {{600, 0.141124587}, {1200, 0.254134509}, {1800, 
    0.342888644}, {2400, 0.424476295}, {3600, 0.562844542}, {4800, 
    0.657111356}, {6000, 0.75137817}, {7200, 0.815876516}, 
       {8430, 0.879823594}, {9000, 0.900771775}, {13200, 1}}; 

YYY = model[De /. fit[[1]], Kf /. fit[[2]], Y /. fit[[3]]]; 

Show[Plot[Evaluate[YYY[L, t]], {t, 0, T}, PlotRange -> All], 
 ListPlot[data, PlotStyle -> Directive[PointSize[Medium], Red]]]

Ссылка на файл .nb: http://www.4shared.com/folder/249TSjlz/_online.html

1 Ответ

3 голосов
/ 12 декабря 2011

У меня есть скрытое подозрение, что причина, по которой он не работает на вас, заключается в том, что вы кешируете результаты.

Вам нужно хранить каждое решение, которое производит NDSolve? Я несколько скептически отношусь к тому, полезно это или нет для Findfit, так как я очень сомневаюсь, что это вернется к прошлому результату.

Кроме того, вы не говорите о целых числах, где есть конечная область, о которой вы говорите. Вы используете реалы и даже в указанном вами диапазоне есть МНОГО различных возможных решений. Я не думаю, что вы хотите хранить каждый из них.

Перепишите ваш код, чтобы вместо: 

model[(De_)?NumberQ, (Kf_)?NumberQ, (Y_)?NumberQ] := 
 model[De, Kf, Y] =  yeld /. Last[Last[
     NDSolve[..]

Вместо этого у вас есть: 

model[(De_)?NumberQ, (Kf_)?NumberQ, (Y_)?NumberQ] := 
 NDSolve[..]

Кэшируя свои предыдущие результаты, вы будете поглощать память, как не завтра с FindFit. Обычно это полезно, когда у вас есть рекуррентное отношение, но здесь я бы серьезно советовался против этого.

Некоторые заметки:

После выполнения в течение 2415 секунд на моей машине использование памяти Mathematica изменилось с 112,475,400 байт до 1,642,280,320 байт с кэшированием.

Сейчас я запускаю код без кэширования.

...