# How to substitute one equation into another sybmbolically with differing lag length, and collect variables?

This question relates to the post 153663. I have the following set of equations and trying to substitute in one into another until expressing $x_{t}$ in terms of $i_{t-3}$, $i_{t-4}$, and earlier.

I have the following code which partially completes the task.

xtRule=x[t]->a[0]+a[1] x[t-1]+a[2] y[t-2]+a[3]z[t-1]+\[Epsilon][t];
ytRule=y[t]->b[0]+b[1] y[t-1]+b[2] i[t-2]+b[3]z[t-1]+\[Eta][t];
ztRule=z[t]->p[1]z[t-1]+p[2]i[t-1]+\[Upsilon][t];
itRule=i[t]->r i[t-1]+(1-r)g y[t-2]+\[Omega][t];

Format[a[i_]]:=SubscriptBox[a,i]//DisplayForm
Format[b[i_]]:=SubscriptBox[b,i]//DisplayForm
Format[p[i_]]:=SubscriptBox[p,i]//DisplayForm
Format[r[i_]]:=SubscriptBox[r,i]//DisplayForm
Format[x[i_]]:=SubscriptBox[Style[x,{Blue,Bold}],i]//DisplayForm
Format[y[i_]]:=SubscriptBox[Style[y,{Brown,Bold}],i]//DisplayForm
Format[z[i_]]:=SubscriptBox[Style[z,{Yellow,Bold}],i]//DisplayForm
Format[i[j_]]:=SubscriptBox[Style[i,{Red,Bold}],j]//DisplayForm
Format[\[Eta][i_]]:=SubscriptBox[\[Eta],i]//DisplayForm
Format[\[Epsilon][i_]]:=SubscriptBox[\[Epsilon],i]//DisplayForm
Format[\[Upsilon][i_]]:=SubscriptBox[\[Upsilon],i]//DisplayForm
Format[\[Omega][i_]]:=SubscriptBox[\[Omega],i]//DisplayForm

getClosestT[Rule[from_,to_]]:=
(to/.x[a_]:>Sow[a]/.y[a_]:>Sow[a]//Reap//Last//Flatten//Union//Last)

applyMultTimesTo[rule_,num_]:=Nest[(#/.({xtRule,ytRule, ztRule, itRule}/.t->getClosestT[#])//ExpandAll//Collect[#,{x[_],y[_],z[_],i[_]},FullSimplify]&)&,rule,num]


When applyMultTimesTo[xtRule, 2] is executed, all variables are lagged twice, I get the following:

$x_t\to a_2 b_2 i_{t-4}+z_{t-3} \left(a_2 b_3+a_3 \left(a_1 p_1+a_1^2+p_1^2\right)\right)+a_2 \left(a_1+b_1\right) y_{t-3}+a_2 b_0+y_{t-4} \left(a_1^2 a_2-a_3 g p_2 (r-1)\right)+a_3 p_2 i_{t-3} \left(a_1+p_1+r\right)+a_3 \left(\left(a_1+p_1\right) \upsilon _{t-2}+p_2 \omega _{t-2}+\upsilon _{t-1}\right)+a_2 \eta _{t-2}+a_1^3 x_{t-3}+a_1^2 \epsilon _{t-2}+a_1 \epsilon _{t-1}+a_0 \left(a_1^2+a_1+1\right)+\epsilon _t$

Note that $x_{t}$ obtained above is partially expressed in terms of $i_{t-3}$ and earlier. It's partial as I need one more substitution i.e. substitute for $z_{t-3}$ only and not substitute for $x_{t-3}$, $y_{t-3}$, and $i_{t-3}$ anymore. In other words, applyMultTimesTo allows me to have $x_{t}$ in terms of the same lag length of variables. But, I need to adjust it to allow different lag lengths.

I would appreciate any suggestions and help. Best,

Side note: for your applyMultTimesTo you probably want to update getClosestT to track changes from z and i as well:

getClosestT[Rule[from_, to_]] := (to /. {x[a_] :> Sow[a] , y[a_] :> Sow[a] ,
z[a_] :> Sow[a] , i[a_] :> Sow[a] }// Reap // Last //
Flatten // Union // Last)


To manually handle your specific example, looks like:

applyMultTimesTo[xtRule, 2] /. (ztRule /. t -> t - 3) // ExpandAll //
Collect[#, {x[_], y[_], z[_], i[_]}, FullSimplify] &


to do this more generally can do define a helper like:

applyThroughXYZI[xT_, yT_, zT_, iT_][expr_] :=
expr //. Flatten[{ Map[xtRule /. (t -> t - #) &, Range[xT]],
Map[ytRule /. (t -> t - #) &, Range[yT]],
Map[ztRule /. (t -> t - #) &, Range[zT]],
Map[itRule /. (t -> t - #) &, Range[iT]]}] // ExpandAll //
Collect[#, {x[_], y[_], z[_], i[_]}, FullSimplify] &


e.g.

xtRule // applyThroughXYZI[2, 2, 3, 2]


Notes:

• FullSimplify is completely cosmetic and can completely slow you down as you get deep/knotty expressions. If things are taking too long to evaluate, remove this part of the collect, i.e. Collect[#, {x[_], y[_], z[_], i[_]}, FullSimplify]$to$Collect[#, {x[_], y[_], z[_], i[_]}]

also to make it easier to find your variables may want to include a large style to your formatting (also I had trouble reading the yellow):

Format[x[i_]] :=
SubscriptBox[Style[x, {Blue, Bold, Large}], i] // DisplayForm
Format[y[i_]] :=
SubscriptBox[Style[y, {Brown, Bold, Large}], i] // DisplayForm
Format[z[i_]] :=
SubscriptBox[Style[z, {RGBColor[0.15, 0.5, 0.38], Bold, Large}], i] //
DisplayForm
Format[i[j_]] :=
SubscriptBox[Style[i, {Red, Bold, Large}], j] // DisplayForm