Message Boards Message Boards

0
|
4972 Views
|
7 Replies
|
2 Total Likes
View groups...
Share
Share this post:

[?] Display system of 4 equations dependent on time and each other?

Posted 6 years ago

Hi everyone,

I do not have much experience with Mathematica and I am hoping to use it to display a system of four equations, where I can set and change the starting values and visualize how the system always reaches equilibrium. I've taken advanced math courses but it has been a while since I've tried to do something like this. I think I've been able to come up with the correct equations, but I'm struggling to find a way to visualize them. Can you help?

My code is below. I added in spaces for ease of reading. I also attached them as a Wolfram file.

Plot [ {A (x >= 1) == ((G (x - 1))/25) - ((A (x - 1))/25) + 
    A (x - 1),

  G (x >= 1) == ((T (x - 1))/25) - ((A (x - 1))/50) + ((G (x - 1))/
      50) + G (x - 1),

  T (x >= 1) == ((A (x - 1))/25) - ((A (x - 1))/75) + ((G (x - 1))/
      75) + ((T (x - 1))/75) + T (x - 1),

  Y (x >= 1) == ((A (x - 1))/25) - ((A (x - 1))/75) + ((G (x - 1))/
      75) + ((T (x - 1))/75) + Y (x - 1),

  A (x < 1) == 30,

  G (x < 1) == 20,

  T (x < 1) == 15,

  Y (x < 1) == 35},

 {x, 0, 100}
 ]
Attachments:
POSTED BY: Jeff Powell
7 Replies
Posted 6 years ago

To plot the point A[100] it needs to calculate the values for A[99] and G[99]. To calculate the values for A[99] it needs to calculate the values for A[98] and G[98]. This repeats over and over and the number of calculations becomes very large. Worse, Even worse, Plot wants to find many many points, not just 100 and 99, but 100 and 99.98 and 99.97.

This only calculates the first ten integer points, but still takes time.

Clear[A, G, T, Y, x];
A[x_] := Piecewise[{{30, x<1}, {G[x-1]/25 - A[x-1]/25 + A[x-1], x>=1}}];
G[x_] := Piecewise[{{20, x<1}, {T[x-1]/25 - A[x-1]/50 + G[x-1]/50 + G[x- 1], x>=1}}];
T[x_] := Piecewise[{{15, x<1}, {A[x-1]/25 - A[x-1]/75 + G[x-1]/75 + T[x-1]/75 + T[x-1], x>=1}}];
Y[x_] := Piecewise[{{35, x<1}, {A[x-1]/25 - A[x-1]/75 + G[x-1]/75 + T[x-1]/75 + Y[x-1], x>=1}}];
ListPlot[Transpose[Table[{A[x], G[x], T[x], Y[x]}, {x, 1, 10}]]]

enter image description here

This is a very different, and likely more difficult to understand, way of trying to solve the problem

Clear[A, G, T, Y, x];
f = {A[x], G[x], T[x], Y[x]} /. RSolve[{
     A[x] == G[x-1]/25. - A[x-1]/25 + A[x-1], A[0] == 30,
     G[x] == T[x-1]/25. - A[x-1]/50 + G[x-1]/50 + G[x-1], G[0] == 20,
     T[x] == A[x-1]/25. - A[x-1]/75 + G[x-1]/75 + T[x-1]/75 + T[x-1], T[0] == 15,
     Y[x] == A[x-1]/25. - A[x-1]/75 + G[x-1]/75 + T[x-1]/75 + Y[x-1], Y[0] == 35},
     {A[x], G[x], T[x], Y[x]}, x];
g2 = Plot[f, {x, 0, 100}]

enter image description here

There are some perhaps serious risks associated with this method. If you look carefully you will see that I introduced four decimal points into that. These instruct Mathematica to use floating point approximations in the calculations and that results in many very tiny complex values introduced into the result. Perhaps surprisingly, Plot does not object to these small complex values.

Please use this with caution. And, as always, carefully check the results for correctness. Look up each of the functions in the help system and see if you can understand how these were done.

POSTED BY: Bill Simpson
Posted 6 years ago

Thanks, Bill! I'll look in to these comments.

I've attached what the route I was looking in to before seeing your comments, in case you'd like to look at it too.

Attachments:
POSTED BY: Jeff Powell
Posted 6 years ago

Mathematica is very strict about the exact form of notation that it will accept. If you can find and read an introduction to programming in Mathematica I think that might help you a lot. When you think you have something figured out then trying simpler examples where you know what the answer or the graph should be can give you feedback on whether you are on the right path.

POSTED BY: Bill Simpson
Posted 6 years ago

Hey Bill,

I went in the direction of your second set of code, as the first took a long time to resolve and limited me to a much shorter x axis. I realized I had made some mistakes in my equations and I've fixed them. Now, I'd like to be able to display a legend which labels and colors each variable. I'm not able to make much progress. The "PlotLegends" command I found labels function f, not each variable within f. I'd also need to change the color of each line in order for my legend to be clear.

Can you help me out again?

Clear[A, G, T, Y, x]; f = {A[x], G[x], T[x], Y[x]} /. RSolve[{ A[x] == (G[x - 1]/25.) - (A[x - 1]/25) + A[x - 1], A[0] == 35, G[x] == (T[x - 1]/ 25.) - (1/3) (A[x - 1]/25) - (2/3) (G[x - 1]/25) + G[x - 1], G[0] == 30, T[x] == (A[x - 1]/ 25.) - (1/4) (A[x - 1]/25) - (1/4) (G[x - 1]/25) - (1/ 2) (T[x - 1]/25) + T[x - 1], T[0] == 20, Y[x] == (A[x - 1]/ 25.) - (1/4) (A[x - 1]/25) - (1/4) (G[x - 1]/25) - (1/ 2) (T[x - 1]/25) + Y[x - 1], Y[0] == 15}, {A[x], G[x], T[x], Y[x]}, x]; g2 = Plot[f, {x, 0, 100}, PlotLegends -> {"Adenine", "Guanine", "Thymine", "Cytosine"}]

POSTED BY: Jeff Powell
Posted 6 years ago

To get your PlotLegends to work append a [[1]] to the end of your RSolve like this

RSolve[<<<stuff>>>][[1]]

enter image description here

To answer your question about why it no longer works when you start making the equations more complicated, with recurrence equations just like calculus and differential equations, there are many such problems which simply do not have a closed form solution and many many more which RSolve and Integrate and DSolve cannot find a close form solution for.

Perhaps you could ask others who work in your field how such problems are usually formulated and posed. That might provide a path to a solution, possibly even one that Mathematica could be used to tackle.

POSTED BY: Bill Simpson
Posted 6 years ago

Thanks for the help, Bill! I'm using this for a class presentation and, though it's not "perfect", I've gotten it to point that I need to get it to for the sake of getting my point across.

POSTED BY: Jeff Powell
Posted 6 years ago

Also, can you help me understand why I'm able to evaluate the first code below, but not the second (which has a square thrown in?)

Clear[A, G, T, Y, x];
f = {A[x], G[x], T[x], Y[x]} /. RSolve[{
     A[x] == (G[x - 1]/25) - (A[x - 1]/25) + A[x - 1],
     A[0] == 35,
     G[x] == (T[x - 1]/25) - (G[x - 1]/25) + G[x - 1],
     G[0] == 30,
     T[x] == (Y[x - 1]/25) - (T[x - 1]/25) + T[x - 1],
     T[0] == 20,
     Y[x] == (A[x - 1]/25) - (Y[x - 1]/25) + Y[x - 1],
     Y[0] == 15},
    {A[x], G[x], T[x], Y[x]}, x];
g2 = Plot[f, {x, 0, 100}, PlotRange -> Full]

Here's the second code:

Clear[A, G, T, Y, x];
f = {A[x], G[x], T[x], Y[x]} /. RSolve[{
     A[x] == (G[x - 1]/25) - (A[x - 1]/25)^2 + A[x - 1],
     A[0] == 35,
     G[x] == (T[x - 1]/25) - (G[x - 1]/25)^2 + G[x - 1],
     G[0] == 30,
     T[x] == (Y[x - 1]/25) - (T[x - 1]/25)^2 + T[x - 1],
     T[0] == 20,
     Y[x] == (A[x - 1]/25) - (Y[x - 1]/25)^2 + Y[x - 1],
     Y[0] == 15},
    {A[x], G[x], T[x], Y[x]}, x];
g2 = Plot[f, {x, 0, 100}, PlotRange -> Full]
POSTED BY: Jeff Powell
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract