An Introduction to Economic Dynamics

Page 22

Clear[a, r];
Manipulate[f = Function[{x}, p x (1 - x)];
 ListPlot[NestList[f, a, 15] /. p -> r, Joined -> True, DataRange -> {0, 15}, PlotRange -> {0, 1}], {r, 0, 4}, {{a, 0.5, "Initial value"}, 0.1, 1}, AppearanceElements -> {}, SaveDefinitions -> True]

Page 24

Manipulate[
 n = 100;
 m = 2100;
  L = Sort[Drop[NestList[ Function[{x}, r x (1 - x)], 0.9, m], n + 1]];
  ListPlot[Table[{L[[i]], i/(m - n)}, {i, 1, m - n}], PlotRange -> {{-0.1, 1.1}, {0, 1}}, AspectRatio -> 1, PlotStyle -> {PointSize[0.004]}],
  {{r, 0.9}, 0, 4, AppearanceElements -> {"InputField"}}, {r, {2, 3.3, 3.5, 3.555, 3.585, 3.6, 3.69, 3.74, 3.84, 3.96, 4}, ControlType -> SetterBar}, AppearanceElements -> {}]

Page 30

Brownian=Function[{n,T},RW= (Sqrt[T/n])Accumulate[2RandomInteger[{0,1},n]-1];Table[{i T/n,RW[[i+1]]},{i,0,n-1}]];
T=2;
n=100000;
Lbr=Brownian[n,T];
Manipulate[ListPlot[Lbr[[Table[i,{i,1,Floor[150(1.05)^r]}]]],Joined->True],{r,Floor[Log[n/150]/Log[1.05]],0,-1},AppearanceElements -> {},SaveDefinitions->True]

Page 36

Clear[f,x];
f=Function[{x},11.56x-50.864 (x^2)+78.608 (x^3)-39.304 (x^4)];
StartingValue=0.3;
FirstIt=0;
LastIt=50;
xmin=0;
xmax=1;
i=0;
y=N[StartingValue];
While[i<FirstIt,y=f[y];i=i+1];
DataTable={{y,y},{y,f[y]}};
While[i<LastIt,
y=f[y];
AppendTo[DataTable,{y,y}];
AppendTo[DataTable,{y,f[y]}];
i=i+1];
AppendTo[DataTable,{f[y],f[y]}];
Cobweb=ListPlot[DataTable,Joined->True,
PlotRange->{{xmin,xmax},{xmin,xmax}},
AspectRatio->1,PlotStyle->GrayLevel[.3],
DisplayFunction->Identity];
Graf=Plot[{f[x],x},{x,xmin,xmax},
PlotRange->{xmin,xmax},AspectRatio->1,
DisplayFunction->Identity];
Show[Cobweb,Graf]

Page 40

Clear[f,a,data,U];
firstIt = 500;         (*First value of t to be plotted*)
iterates = 500;    (*Number of iterations to be calculated after firstIt*)
p0 = 0.5;                    (*Initial value*)
amin=0;                      (*Minimum value for the parameter*)
amax=3.52;                   (*Maximum vale for the parameter*)
asteps=1000;            (*Number of points evaluated between amin and amax*)
f=Function[p,a p (1-p)];
data={};
Do[a=amin+((amax-amin)/asteps)*d;
U=Union[Drop[NestList[f,p0,firstIt+iterates],firstIt]];
data=Join[data,Table[{a,U[[i]]},{i,1,Length[U]}]],
{d,0,asteps}];
ListPlot[data,PlotRange->{{amin,amax},{0,1}},PlotStyle->{PointSize[.001]}]

Page 47

Manipulate[ParametricPlot[{{1.3+ArcTan[m(p-2)],p},{1.3+v-0.25(p-2),p}},{p,0,5},PlotRange->{{0,4},{0,5}},AxesLabel->{"q","p"},AxesOrigin->{0,0},ImageSize->200],{{m,3,"μ"},2,5},{{v,-0.2},-1.5,1.5},AppearanceElements->{}]

Page 50

hh[uu_,vv_,cc_,xx0_,xx1_]:=Module[{dat={xx0,xx1},uuu=uu,vvv=vv,ccc=cc},Do[dat=Append[dat,(uuu+vvv) dat[[-1]]-uuu vvv  dat[[-2]] + ccc],{i,0,30}];dat];
Manipulate[
dat=hh[(Subscript[ξ, 1]),(Subscript[ξ, 2]),c,x0,x1];
ListPlot[dat,ImageSize->300, Joined->True,PlotRange->{Min[Min[dat],0],Max[dat]}],
{{(Subscript[ξ, 1]),0.5},-2,2},{{(Subscript[ξ, 2]),0.5},-2,2},{{c,0.1},-2,2},{{x0,0},0,2},{{x1,1},0,2},SaveDefinitions->True, ControlPlacement->Left,AppearanceElements->{}]

Page 51

Manipulate[ListPlot[Table[r^t*Cos[t a + b], {t, 0, n}], Joined -> True, DataRange -> {0,
                n}, ImageSize -> 350, PlotRange -> {-Max[r^n, 1] - 0.01, Max[r^n, 1]}], {{a, 2, "θ"}, 0, 2 Pi}, {{b, 0, "ϕ"}, 0, 2 Pi}, {{r, 1}, 0.7, 1.3}, {{n, 30}, 10, 100}, ControlPlacement -> Left, AppearanceElements -> {}]

Page 62

RSolve[{x[t + 1] == 3 - 0.5 y[t], y[t + 1] == 3 - 0.5 x[t], x[0] == a, y[0] == b}, {x, y}, t];
h = Function[{t, a, b}, Evaluate[{x[t], y[t]} /. %[[1]]]];
Manipulate[
 ItNum = 10;
 ListPlot[Table[h[t, p[[1]], p[[2]]], {t, 0, ItNum}], Joined -> True, ImageSize -> 200, PlotRange -> {{0, 4}, {0, 4}}, AspectRatio -> Automatic], {{p, {3, 0}}, Locator}, AppearanceElements -> {}, SaveDefinitions -> True]

Page 69

Page 76

Manipulate[
F=(x/.DSolve[{x''[t]==((Subscript[ξ, 1])+(Subscript[ξ, 2]))x'[t]-(Subscript[ξ, 1]) (Subscript[ξ, 2])x[t]+c,x[0]==x0,x'[0]==x1},x,t][[1]]);
Plot[F[t],{t,0,T},ImageSize->300,PlotRange->{0,Max[5,F[T]]},AxesLabel->{"t","x(t)"}],{{(Subscript[ξ, 1]),-1},-2,2},{{(Subscript[ξ, 2]),-2},-2,2},{{c,3},0,5},{{x0,1,"x(0)"},0,2},{{x1,2,"x'(0)"},-5,5},{{T,10,"t"},10,200},ControlPlacement->Left,AppearanceElements->{}]

Page 77

Manipulate[Plot[r^t*Cos[t a + b], {t, 0, T}, ImageSize -> 350, PlotRange -> {-Max[r^T, 1] - 0.01, Max[r^T, 1]}, AxesLabel -> {"t", "x(t)"}], {{a, 2, "θ"}, 0, 2 Pi}, {{b, 0, "ϕ"}, 0, 2 Pi}, {{r, 1}, 0.7, 1.3}, {{T, 30, "t"}, 10, 100}, ControlPlacement -> Left, AppearanceElements -> {}]

Page 80

Clear[P,m,p0,p1,h,j,k,α,β,U];
T=1/6;
DSolve[{P''[t]==j β k m-(β k+j(1-h)) P'[t]-j β k P[t],P[0]==p0,P'[0]==p1},P,t];
P=Function[{m,p0,p1,h,j,k,α,β},Evaluate[P/.%[[1]]]];
p=Function[{m,p0,p1,h,j,k,α,β},Evaluate[P[m,p0,p1,h,j,k,α,β][t]+(1/j)P[m,p0,p1,h,j,k,α,β]'[t]]];
U=Function[{m,p0,p1,h,j,k,α,β},Evaluate[(1/β)(α-T-(1-h)P[m,p0,p1,h,j,k,α,β][t]-(1/j)P[m,p0,p1,h,j,k,α,β]'[t])]];
Manipulate[Plot[{p[m,p0,p1,h,j,k,α,β,t],U[m,p0,p1,h,j,k,α,β,t],P[m,p0,p1,h,j,k,α,β][t],m,((α-T-(1-h)m)/β)},{t,0,tt},PlotRange->{-0.05,0.1},ImageSize->300],{{p0,0.02},0,0.1},{{p1,0.01},0,0.1},{{m,0.05},0,0.1},{{h,0.6},-3,1},{{j,0.2},0.1,1},{{k,0.5},0.01,1},{{α,0.02},0.01,1},{{β,3},0.1,5},{{tt,10,"t"},5,30},SaveDefinitions->True,AppearanceElements->{}]

Page 81

DSolve[{x'[t]==-x[t]+4 y[t]-10,y'[t]==-4 x[t]-y[t]+28,x[0]==aa,y[0]==bb},{x[t],y[t]},t];
Manipulate[ParametricPlot[{x[t],y[t]}/. %[[1]]/. {aa->p[[1]],bb->p[[2]]},{t,0,5},ImageSize->250,PlotRange->{{0,10},{0,10}}],{{p,{1,1}},Locator},AppearanceElements->{}]

Page 83

Page 84

Page 86