# Simplifying an expression(s) for an equilibrium point?

Trying to use Bob Hanlon's solution from here for the following system doesn't seem to work here, why?

How do I simplify the equilibrium point to this simplified expression?

eqPts = {{s -> ((δa + μ - σ) (α + δi + μ + τ))/(βi σ + βa (α + δi + μ + τ)),
a -> -(((α + δi + μ + τ) (μ (μ + ξ + ρ) (δa + μ - σ) (α + δi + μ + τ) + b (μ (-1 + ν) - ξ) (βi σ + βa (α + δi + μ + τ))))/((δi μ^2 + μ^3 + δi μ ξ + μ^2 ξ + α μ (δa + μ + ξ) - δi μ σ -  μ^2 σ - 2 δi ξ σ - μ ξ σ - α (μ + ξ) σ + (μ + ξ) (μ - σ) τ + δa μ (δi + μ + τ)) (βi σ + βa (α + δi + μ + τ)))),
i -> -((σ (μ (μ + ξ + ρ) (δa + μ - σ) (α + δi + μ + τ) + b (μ (-1 + ν) - ξ) (βi σ + βa (α + δi + μ + τ))))/((δi μ^2 + μ^3 + δi μ ξ + μ^2 ξ + α μ (δa + μ + ξ) - δi μ σ - μ^2 σ - 2 δi ξ σ - μ ξ σ - α (μ + ξ) σ + (μ + ξ) (μ - σ) τ + δa μ (δi + μ + τ)) (βi σ + βa (α + δi + μ + τ)))),
r -> (-(δa + μ - σ) (α + δi + μ + τ) (α δa μ - δi μ ρ - μ^2 ρ + δi μ σ + 2 δi ρ σ + μ ρ σ + α ρ (-μ + σ) - μ ρ τ + ρ σ τ + δa μ (δi + μ + τ)) + b (δi μ ν + μ^2 ν + α (δa + ν (μ - σ)) + δi σ - 2 δi ν σ - μ ν σ + ν (μ - σ) τ + δa (δi + μ + τ)) (βi σ + βa (α + δi + μ + τ)))/((δi μ^2 + μ^3 + δi μ ξ + μ^2 ξ + α μ (δa + μ + ξ) - δi μ σ - μ^2 σ - 2 δi ξ σ - μ ξ σ - α (μ + ξ) σ + (μ + ξ) (μ - σ) τ + δa μ (δi + μ + τ)) (βi σ + βa (α + δi + μ + τ)))}};

LeafCount /@ {eqPts, eqPts2 = eqPts // Simplify}

eqns = eqPts2 /. Rule :> Equal;

vars = eqns[[1, All, 1]]

params = Complement[Variables[Level[eqns, {-1}]], vars]

solve[solveVar_Symbol, var_Symbol] :=
SortBy[Union[
Simplify[
Solve[eqns[[2]],
solveVar, #] & /@ (Append[
Complement[vars, {solveVar, var}], #] & /@ params) /. {} :>
Nothing]], LeafCount][[1, 1]]

solve[a, i]


This should give us

$$A^*=\frac{\mu+\delta_i+\tau+\alpha}{\sigma} I^*$$

But it doesn't, why?

EDIT: Trying Bob's solution, i get the following error:

In[66]:= eqns = eqPts2 /. Rule :> Equal;
vars = eqns[[1, All, 1]]

During evaluation of In[66]:= Part::partd: Part specification {s==((\[Delta]a+\[Mu]-\[Sigma]) (\[Alpha]+\[Delta]i+\[Mu]+\[Tau]))/(\[Beta]i \[Sigma]+\[Beta]a Plus[<<4>>]),a==-(((\[Alpha]+\[Delta]i+\[Mu]+\[Tau]) (\[Mu] (\[Mu]+\[Xi]+\[Rho]) (\[Delta]a+\[Mu]+Times[<<2>>]) (\[Alpha]+\[Delta]i+\[Mu]+\[Tau])+b (Times[<<2>>]+Times[<<2>>]) (Times[<<2>>]+Times[<<2>>])))/((\[Delta]i Power[<<2>>]+\[Mu]^3+\[Delta]i \[Mu] \[Xi]+Power[<<2>>] \[Xi]+\[Alpha] \[Mu] Plus[<<3>>]-\[Delta]i \[Mu] \[Sigma]-<<1>><<1>><<1>>-2 \[Delta]i \[Xi] \[Sigma]-\[Mu] \[Xi] \[Sigma]-\[Alpha] Plus[<<2>>] \[Sigma]+Plus[<<2>>] Plus[<<2>>] \[Tau]+\[Delta]a \[Mu] Plus[<<3>>])<<1>><<1>>)),i==-((\[Sigma] (<<1>>+<<1>>))/((<<1>>) (<<1>>))),r==((Times[<<2>>]+Times[<<2>>]+\[Sigma]) (\[Alpha]+\[Delta]i+\[Mu]+\[Tau]) (Times[<<3>>]+Times[<<4>>]+Times[<<3>>]+Times[<<3>>]+Times[<<4>>]+Times[<<3>>]+Times[<<3>>]+Times[<<4>>]+Times[<<3>>]+Times[<<3>>])+b (Times[<<3>>]+Times[<<2>>]+Times[<<2>>]+Times[<<2>>]+Times[<<4>>]+Times[<<4>>]+Times[<<3>>]+Times[<<2>>]) (Times[<<2>>]+Times[<<2>>]))/((\[Delta]i Power[<<2>>]+\[Mu]^3+\[Delta]i \[Mu] \[Xi]+Power[<<2>>] \[Xi]+\[Alpha] \[Mu] Plus[<<3>>]-\[Delta]i \[Mu] \[Sigma]-Power[<<2>>] \[Sigma]-2 \[Delta]i \[Xi] \[Sigma]-\[Mu] \[Xi] \[Sigma]-\[Alpha] Plus[<<2>>] \[Sigma]+Plus[<<2>>] Plus[<<2>>] \[Tau]+\[Delta]a \[Mu] Plus[<<3>>]) (\[Beta]i \[Sigma]+\[Beta]a Plus[<<4>>]))}[[1,All,1]] is longer than depth of object.

Out[67]= {s == ((\[Delta]a + \[Mu] - \[Sigma]) (\[Alpha] + \[Delta]i \
+ \[Mu] + \[Tau]))/(\[Beta]i \[Sigma] + \[Beta]a (\[Alpha] + \
\[Delta]i + \[Mu] + \[Tau])),
a == -(((\[Alpha] + \[Delta]i + \[Mu] + \[Tau]) (\[Mu] (\[Mu] + \
\[Xi] + \[Rho]) (\[Delta]a + \[Mu] - \[Sigma]) (\[Alpha] + \[Delta]i \
+ \[Mu] + \[Tau]) +
b (\[Mu] (-1 + \[Nu]) - \[Xi]) (\[Beta]i \[Sigma] + \[Beta]a (\
\[Alpha] + \[Delta]i + \[Mu] + \[Tau]))))/((\[Delta]i \[Mu]^2 + \
\[Mu]^3 + \[Delta]i \[Mu] \[Xi] + \[Mu]^2 \[Xi] + \[Alpha] \[Mu] (\
\[Delta]a + \[Mu] + \[Xi]) - \[Delta]i \[Mu] \[Sigma] - \[Mu]^2 \
\[Sigma] -
2 \[Delta]i \[Xi] \[Sigma] - \[Mu] \[Xi] \[Sigma] - \[Alpha] (\
\[Mu] + \[Xi]) \[Sigma] + (\[Mu] + \[Xi]) (\[Mu] - \[Sigma]) \[Tau] + \
\[Delta]a \[Mu] (\[Delta]i + \[Mu] + \[Tau])) (\[Beta]i \[Sigma] + \
\[Beta]a (\[Alpha] + \[Delta]i + \[Mu] + \[Tau])))),
i == -((\[Sigma] (\[Mu] (\[Mu] + \[Xi] + \[Rho]) (\[Delta]a + \[Mu] \
- \[Sigma]) (\[Alpha] + \[Delta]i + \[Mu] + \[Tau]) +
b (\[Mu] (-1 + \[Nu]) - \[Xi]) (\[Beta]i \[Sigma] + \[Beta]a (\
\[Alpha] + \[Delta]i + \[Mu] + \[Tau]))))/((\[Delta]i \[Mu]^2 + \
\[Mu]^3 + \[Delta]i \[Mu] \[Xi] + \[Mu]^2 \[Xi] + \[Alpha] \[Mu] (\
\[Delta]a + \[Mu] + \[Xi]) - \[Delta]i \[Mu] \[Sigma] - \[Mu]^2 \
\[Sigma] -
2 \[Delta]i \[Xi] \[Sigma] - \[Mu] \[Xi] \[Sigma] - \[Alpha] (\
\[Mu] + \[Xi]) \[Sigma] + (\[Mu] + \[Xi]) (\[Mu] - \[Sigma]) \[Tau] + \
\[Delta]a \[Mu] (\[Delta]i + \[Mu] + \[Tau])) (\[Beta]i \[Sigma] + \
\[Beta]a (\[Alpha] + \[Delta]i + \[Mu] + \[Tau])))),
r == ((-\[Delta]a - \[Mu] + \[Sigma]) (\[Alpha] + \[Delta]i + \[Mu] \
+ \[Tau]) (\[Alpha] \[Delta]a \[Mu] - \[Delta]i \[Mu] \[Rho] - \
\[Mu]^2 \[Rho] + \[Delta]i \[Mu] \[Sigma] +
2 \[Delta]i \[Rho] \[Sigma] + \[Mu] \[Rho] \[Sigma] + \
\[Alpha] \[Rho] (-\[Mu] + \[Sigma]) - \[Mu] \[Rho] \[Tau] + \[Rho] \
\[Sigma] \[Tau] + \[Delta]a \[Mu] (\[Delta]i + \[Mu] + \[Tau])) +
b (\[Delta]i \[Mu] \[Nu] + \[Mu]^2 \[Nu] + \[Alpha] (\[Delta]a \
+ \[Nu] (\[Mu] - \[Sigma])) + \[Delta]i \[Sigma] -
2 \[Delta]i \[Nu] \[Sigma] - \[Mu] \[Nu] \[Sigma] + \[Nu] (\
\[Mu] - \[Sigma]) \[Tau] + \[Delta]a (\[Delta]i + \[Mu] + \[Tau])) (\
\[Beta]i \[Sigma] + \[Beta]a (\[Alpha] + \[Delta]i + \[Mu] + \
\[Tau])))/((\[Delta]i \[Mu]^2 + \[Mu]^3 + \[Delta]i \[Mu] \[Xi] + \
\[Mu]^2 \[Xi] + \[Alpha] \[Mu] (\[Delta]a + \[Mu] + \[Xi]) - \
\[Delta]i \[Mu] \[Sigma] - \[Mu]^2 \[Sigma] -
2 \[Delta]i \[Xi] \[Sigma] - \[Mu] \[Xi] \[Sigma] - \[Alpha] \
(\[Mu] + \[Xi]) \[Sigma] + (\[Mu] + \[Xi]) (\[Mu] - \[Sigma]) \[Tau] \
+ \[Delta]a \[Mu] (\[Delta]i + \[Mu] + \[Tau])) (\[Beta]i \[Sigma] + \
\[Beta]a (\[Alpha] + \[Delta]i + \[Mu] + \[Tau])))}[[1, All, 1]] is longer than depth of object.

• Look at the error messages. eqns has only one element, so eqns[[2]] produces an error May 12, 2022 at 16:33
• How would I fix this?
– Math
May 12, 2022 at 17:03
• eqns is a list with only 1 element, namely a sublist. Therefore, this definition seems strange. May 12, 2022 at 17:08

Starting with eqPts

LeafCount /@ {eqPts, eqPts2 = eqPts // Simplify}

(* {510, 510} *)


Note that the attempted simplification did not change the expression.

eqPts === eqPts2

(* True *)

eqns = eqPts2 /. Rule :> Equal;

vars = eqns[[1, All, 1]]

(* {s, a, i, r} *)

params = Complement[Variables[Level[eqns, {-1}]], vars]

(* {b, α, βa, βi, δa, δi, μ, ν, ξ, ρ, σ, τ} *)


In your previous problem there were two equilibrium points as opposed to the one given here. Consequently, eqns[[2]] doesn't exist. Change this to eqns[[1]]. I have also restricted the parameters considered for elimination to the first six.

solve[solveVar_Symbol, var_Symbol] :=
SortBy[Union[Simplify[Solve[eqns[[1]], solveVar, #] & /@
(Append[Complement[vars, {solveVar, var}], #] & /@
params[[1 ;; 6]]) /. {} :> Nothing]], LeafCount][[1, 1]]

sol = solve[a, i]

(* {a -> (i (α + δi + μ + τ))/σ} *)

• When I tried this solution, it outputted an error message when entering the vars= ... part. the error message was part specification .... [[1,All,1]] is longer than depth of object
– Math
May 16, 2022 at 9:26
• Please look at the error message edited in the question. Also can you solve for variable "r" in terms of variable "i"? Thank you, it is appreciated!
– Math
May 16, 2022 at 9:58
• I cannot reproduce the error. From your error message it looks like you may have removed the outer set of List brackets from eqPts2 (or earlier). May 16, 2022 at 15:56
• Thank you, I missed the extra bracket. Regards.
– Math
May 16, 2022 at 16:12