在mathematica中计算太慢(而R运行相同的代码非常快)

时间:2013-12-19 02:50:00

标签: wolfram-mathematica

我已经制作了以下代码,用于在离散时间框架中模拟一组变量的演变。但mathematica计算太慢了。我使用R进行了相同的模拟,结果立即显示出来。但是使用mathematica它需要永远。我需要模拟模型至少100个周期,并且R没有问题。但是对于mathematica,我不能随着时间的推移12。从时间13开始,它需要永远。有没有什么方法可以像R一样快速地使用mathematica进行模拟? mathematica代码如下所示:

时间段:

period = Range[3, 13]

参数值:

p = 0.7
q = 0.2
k = 0.3
id = 0.05
il = 0.1
TP = 3
TP = 3
TC = 1
TF = 3

某些初始阶段的价值:

Q[0] = Q[1] = Q[2] = 1
X[0] = X[1] = X[2] = 1
FK[0] = FK[1] = FK[2] = 1
FH[0] = FH[1] = FH[2] = 1
S[0] = S[1] = S[2] = 0.5
C[0] = C[1] = C[2] = 0.5
P[0] = P[1] = P[2] = 0.5
BK[0] = BK[1] = BK[2] = 0.1
BH[0] = BH[1] = BH[2] = 0.1
LK[0] = LK[1] = LK[2] = 1
LH[0] = LH[1] = LH[2] = 1
r[0] = r[1] = r[2] = 0.1

系统方程(或函数):

C[t_] := ((1 + p*q)/(1 + q))*S[t - TF] + p*id*FK[t - TF] - p*id*LK[t - TF] + BK[t]

S[t_] := (1 - k)*C[t] + k*C[t - TC] + (((1 - p)*q)/(1 + q))*S[t - TC] + id*(1 - p)*FK[t - TC] - il*(1 - p)*LK[t - TC] + id*FH[t - TC] - il*LH[t - TC] + BH[t]

FK[t_] := FK[t - 1] + S[t - 1]/(1 + q) + p*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) - C[t - 1] + BK[t - 1]

FH[t_] := FH[t - 1] + k*C[t - 1] + (1 - p)*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) + id*FH[t - 1] - il*LH[t - 1] - (k*C[t - 1 - TC] + (1 - p)*((q/(1 + q))*S[t - 1 - TC] + id*FK[t - 1 - TC] - il*LK[t - 1 - TC]) + id*FH[t - 1 - TC] - il*LH[t - 1 - TC]) + BH[t - 1]

P[t_] := C[t - TP]

Q[t_] := Q[t - 1] + C[t - 1] - P[t - 1]

X[t_] := X[t - 1] + P[t - 1] - 1/(1 + q)*S[t - 1]

gBK[t_] := 0.03 + 0.5*r[t] - 0.2*il

gBH[t_] := 0.05 - 0.05*q - 0.01*il

BK[t_] := (1 + gBK[t - 1])*BK[t - 1]

BH[t_] := (1 + gBH[t - 1])*BH[t - 1]

LK[t_] := LK[t - 1] + BK[t - 1]

LH[t_] := LH[t - 1] + BH[t - 1]

r[t_] := (q/(1 + q)*S[t])/(Q[t] + X[t])

然后我运行以下内容:

ListPlot[Map[C, period]]

如果期限超过12,我永远不会得到结果。谢谢!

1 个答案:

答案 0 :(得分:3)

关于您的代码的两个观察结果:

1)不要用大写字母开头。惯例是只有系统定义的符号以大写字母开头(你用C[n]落入陷阱) 2)了解备忘录。递归定义需要更快(这是你的情况)。

您可以立即运行(修改后的)代码:

p = 0.7;
q = 0.2;
k = 0.3;
id = 0.05;
il = 0.1;
TP = 3;
TP = 3;
TC = 1;
TF = 3;
Q[0] = Q[1] = Q[2] = 1;
X[0] = X[1] = X[2] = 1;
FK[0] = FK[1] = FK[2] = 1;
FH[0] = FH[1] = FH[2] = 1;
S[0] = S[1] = S[2] = 0.5;
c[0] = c[1] = c[2] = 0.5;
P[0] = P[1] = P[2] = 0.5;
BK[0] = BK[1] = BK[2] = 0.1;
BH[0] = BH[1] = BH[2] = 0.1;
LK[0] = LK[1] = LK[2] = 1;
LH[0] = LH[1] = LH[2] = 1;
r[0] = r[1] = r[2] = 0.1;
c[t_] := c[t] = ((1 + p*q)/(1 + q))*S[t - TF] + p*id*FK[t - TF] - 
   p*id*LK[t - TF] + BK[t]
S[t_] := S[t] = (1 - k)*c[t] + 
   k*c[t - TC] + (((1 - p)*q)/(1 + q))*S[t - TC] + 
   id*(1 - p)*FK[t - TC] - il*(1 - p)*LK[t - TC] + id*FH[t - TC] - 
   il*LH[t - TC] + BH[t]
 FK[t_] := FK[t] = FK[t - 1] + S[t - 1]/(1 + q) + 
   p*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) - c[t - 1] + BK[t - 1]
 FH[t_] :=  FH[t] = FH[t - 1] + 
   k*c[t - 1] + (1 - p)*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - 
      il*LK[t - 1]) + id*FH[t - 1] - il*LH[t - 1] - (k*
      c[t - 1 - TC] + (1 - p)*((q/(1 + q))*S[t - 1 - TC] + 
        id*FK[t - 1 - TC] - il*LK[t - 1 - TC]) + id*FH[t - 1 - TC] - 
     il*LH[t - 1 - TC]) + BH[t - 1]
P[t_] := P[t] = c[t - TP]
Q[t_] := Q[t] = Q[t - 1] + c[t - 1] - P[t - 1]
X[t_] := X[t] = X[t - 1] + P[t - 1] - 1/(1 + q)*S[t - 1]
gBK[t_] := 0.03 + 0.5*r[t] - 0.2*il
gBH[t_] := 0.05 - 0.05*q - 0.01*il
BK[t_] := BK[t] = (1 + gBK[t - 1])*BK[t - 1]
BH[t_] := BH[t] = (1 + gBH[t - 1])*BH[t - 1]
LK[t_] := LK[t] = LK[t - 1] + BK[t - 1]
LH[t_] := LH[t] = LH[t - 1] + BH[t - 1]
 r[t_] := (q/(1 + q)*S[t])/(Q[t] + X[t])

然后

ListPlot[c /@ Range[3, 60]]

Mathematica graphics