0
$\begingroup$

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.
$\endgroup$
3
  • $\begingroup$ Look at the error messages. eqns has only one element, so eqns[[2]] produces an error $\endgroup$ May 12, 2022 at 16:33
  • $\begingroup$ How would I fix this? $\endgroup$
    – Math
    May 12, 2022 at 17:03
  • $\begingroup$ eqns is a list with only 1 element, namely a sublist. Therefore, this definition seems strange. $\endgroup$ May 12, 2022 at 17:08

1 Answer 1

2
$\begingroup$

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 + μ + τ))/σ} *)
$\endgroup$
4
  • $\begingroup$ 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 $\endgroup$
    – Math
    May 16, 2022 at 9:26
  • $\begingroup$ 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! $\endgroup$
    – Math
    May 16, 2022 at 9:58
  • 1
    $\begingroup$ 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). $\endgroup$
    – Bob Hanlon
    May 16, 2022 at 15:56
  • $\begingroup$ Thank you, I missed the extra bracket. Regards. $\endgroup$
    – Math
    May 16, 2022 at 16:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.