So I'm trying to create a graph of mu as a function of a variable A, where mu is part of a solution to the following system of 17 non-linear equations (with lambda, A, and r as parameters). However, I can't seem to find a way for Mathematica to solve this. Does anyone know how to solve a large system of non-linear equations? Have been researching methods for almost a month now but still no luck.
Also, to graph mu versus A, do I need Mathematica to solve this, or is there another method?
Solve[
mu*(yB - xB) = (1 - mu)*(xS - yS) &&
0 == -lambda*xB*yS - lambda*xB*(A - xS) + mu*(A*(1 - A - yB) - (1 - A)*xB) &&
0 == -lambda*yB*xS + lambda*(1 - A - yB)*yS + mu*((1 - A)*(A - xB) - A*yB) &&
0 == -lambda*xS*yB + lambda*(A - xS)*xB + (1 - mu)*(A*(1 - A - yS) - (1 - A)*xS) &&
0 == -lambda*yS*xB - lambda*yS*(1 - A - yB) + (1 - mu)*((1 - A)*(A - xS) - A*yS) &&
r*VBhn == lambda/mu*yS*(VBho - VBhn - PSB) + lambda/mu*(A - xS)*(VBho - VBhn - PACh) + (1 - A)*(VBln - VBhn) &&
r*VBlo == lambda/mu*xS*(VBln - VBlo + PBS) + A*(VBho - VBlo) + (1 - delta) &&
r*VBln == lambda/mu*yS*(VBlo - VBln - PACl) + A*(VBhn - VBln) &&
r*VBho == (1 - A)*(VBlo - VBho) + 1 &&
r*VShn == lambda/(1 - mu)*yB*(VSho - VShn - PBS) + (1 - A)*(VSln - VShn) &&
r*VSlo == lambda/(1 - mu)*xB*(VSln - VSlo + PSB) + lambda/(1 - mu)*(1 - A - yB)*(VSln - VSlo + PACl) + A*(VSho - VSlo) + (1 - delta) &&
r*VSln == A*(VShn - VSln) &&
r*VSho == lambda/(1 - mu)*xB*(VShn - VSho + PACh) + (1 - A)*(VSlo - VSho) + 1 &&
VBho - VBhn - PSB == VSln - VSlo + PSB &&
VBln - VBlo + PBS == VSho - VShn - PBS &&
VBho - VBhn - PACh == VShn - VSho + PACh &&
VBlo - VBln - PACl == VSln - VSlo + PACl,
{mu, xS, xB, yS, yB, VBhn, VBlo, VBln, VBho, VShn, VSlo, VSln, VSho, PSB, PBS, PACh, PACl}
]
Related
I have an implicit function, and I'm trying to plot the derivative of the solution of this function.
The function is:
p = \[Phi]/(1/\[Beta]) + ((1 - \[Phi]) \[Phi] (1 - \[Lambda]) \
\[Beta])/(((W - A) 1/\[Beta] + \[Phi] A/
p) 1/\[Beta] + \[Phi]*(1 - \[Phi]) A/p)/(
1/\[Beta] (\[Lambda]/((W - A) 1/\[Beta] + \[Phi] (A/
p) ) + (1 - \[Lambda])/(((W - A) 1/\[Beta] + \[Phi] A/
p) 1/\[Beta] + \[Phi] (1 - \[Phi]) A/p)))
And I would like to plot the derivative of the following expression w.r.t \[Phi]
\[Phi]/p ((1-\[Phi]) A + 1/\[Beta] A )
I've been trying to first solve for p explicitly, and plug the solution into the expression above and plot the derivative of the expression, but kept getting an error. My code is :
Manipulate[
ans = p /.
Solve[p - \[Phi]/(
1/\[Beta]) - ((1 - \[Phi]) \[Phi] (1 - \[Lambda]) \[Beta])/(((W \
- A) 1/\[Beta] + \[Phi] A/p) 1/\[Beta] + \[Phi]*(1 - \[Phi]) A/p)/(
1/\[Beta] (\[Lambda]/((W - A) 1/\[Beta] + \[Phi] (A/
p) ) + (1 - \[Lambda])/(((W - A) 1/\[Beta] + \[Phi] A/
p) 1/\[Beta] + \[Phi] (1 - \[Phi]) A/p))) == 0, p],
Plot[Evaluate[
D[f[\[Phi]] == \[Phi]/
ans[[2]] ((1 - \[Phi]) A + 1/\[Beta] A), \[Phi]]], {\[Phi],
0.01, 1}], {A, 10, 500}, {\[Beta], 0.001, 1}, {W, 100,
10^9}, {\[Lambda], 0.01, 1}]
The error I'm getting is:
"Manipulate:Manipulate argument \
Plot[Evaluate[\!\(\*SubscriptBox[\(\[PartialD]\), \(\[Phi]\)]\((f[\
\[Phi]] == \((\[Phi]\\\ Power[<<2>>])\)\\\ \((Times[<<2>>] +
Times[<<2>>])\))\)\)],{\[Phi],0.01,1}] does not have the correct \
form for a variable specification"
What am I doing wrong?
Thank you!
I am trying to solve this problem using dynamic programming but getting wrong answer. I think the recurrence i am using is incorrect. What should be the recurrence relation for the problem and what information should the dp state hold? At present, i am using a 2-dimensional array where dp[i][j] denotes the maximum number of scoops for rectangle of size (i x j), So answer will be dp[n - 1][n - 1].-> Problem Statement
My Code:
1) s[n][n] is the grid that is given in the problem.
2) end[i][j].first is 1 if s[i][j] is used in the solution for (i x j) rectangle and 0 otherwise.
3) end[i][j].second is 1 if s[i][j] is joined with upper-# and 2 if left-# and 0 if s[i][j] is not used.
int dp[n][n];
pair<int, int> end[n][n];
for (int i = 0; i < n; ++i) {
for (int j = 0; j < n; ++j) {
// w is the answer for (i x j) without using s[i][j]
w = (i - 1 >= 0 ? dp[i - 1][j] : 0) + (j - 1 >= 0 ? dp[i][j - 1] : 0) - (i - 1 >= 0 && j - 1 >= 0 ? dp[i - 1][j - 1] : 0);
if (i - 1 >= 0 && j - 1 >= 0 && end[i - 1][j].first == 1 && end[i - 1][j].second == 2 && end[i][j - 1].first == 1 && end[i][j - 1].second == 1) w--;
x = y = 0;
if (s[i][j] == '#') {
if (i > 0) {
// using the upper # if present
if (s[i - 1][j] == '#') x = 1 + (i - 2 >= 0 ? dp[i - 2][j] : 0) + (j - 1 >= 0 ? dp[i][j - 1] : 0) - (i - 2 >= 0 && j - 1 >= 0 ? dp[i - 2][j - 1] : 0);
if (i - 2 >= 0 && j - 1 >= 0 && end[i - 1][j - 1].first == 1 && end[i - 1][j - 1].second == 1 && end[i - 2][j].first == 1 && end[i - 2][j].second == 2) x--;
if (x <= w) x = 0;
}
if (j > 0) {
//using the left # if present
if (s[i][j - 1] == '#') y = 1 + (i - 1 >= 0 ? dp[i - 1][j] : 0) + (j - 2 >= 0 ? dp[i][j - 2] : 0) - (i - 1 >= 0 && j - 2 >= 0 ? dp[i - 1][j - 2] : 0);
if (i - 1 >= 0 && j - 2 >= 0 && end[i - 1][j - 1].first == 1 && end[i - 1][j - 1].second == 2 && end[i][j - 2].first == 1 && end[i][j - 2].second == 1) y--;
if (y <= w) y = 0;
}
}
// choosing the maximum of the three and accordingly assigning end[i][j]
if (w >= x && w >= y) {
dp[i][j] = w;
end[i][j] = make_pair(0, 0);
} else if (x > w && x > y) {
dp[i][j] = x;
end[i][j] = make_pair(1, 1);
} else {
dp[i][j] = y;
end[i][j] = make_pair(1, 2);
}
}
}
This problem is not about dynamic programming. It's about the maximum matching. Let's paint the grid with black and white colors(like a chess board). Now we have a bipartite graph(black cells are in the first part and white cells are in the second one). We should add edges between adjacent cells if both of them contain oil. The answer is the size of the maximum matching in this graph.
I have made the following code for simulating an evolution of a set of variables in a discreet-time framework. But the mathematica computation is way too slow. I did the same simulation using R and the result comes out right away. But with mathematica it takes forever. I need to simulate the model for at least 100 periods, and there is no problem with R. But with mathematica, I cannot go over time 12. From time 13, it takes forever. Is there any way I can run the simulation with mathematica as fast as R? The mathematica code looks like the following:
Time period:
period = Range[3, 13]
The paramter value:
p = 0.7
q = 0.2
k = 0.3
id = 0.05
il = 0.1
TP = 3
TP = 3
TC = 1
TF = 3
Value for some initial periods:
Q[0] = Q[1] = Q[2] = 1
X[0] = X[1] = X[2] = 1
FK[0] = FK[1] = FK[2] = 1
FH[0] = FH[1] = FH[2] = 1
S[0] = S[1] = S[2] = 0.5
C[0] = C[1] = C[2] = 0.5
P[0] = P[1] = P[2] = 0.5
BK[0] = BK[1] = BK[2] = 0.1
BH[0] = BH[1] = BH[2] = 0.1
LK[0] = LK[1] = LK[2] = 1
LH[0] = LH[1] = LH[2] = 1
r[0] = r[1] = r[2] = 0.1
A System Equations (or functions):
C[t_] := ((1 + p*q)/(1 + q))*S[t - TF] + p*id*FK[t - TF] - p*id*LK[t - TF] + BK[t]
S[t_] := (1 - k)*C[t] + k*C[t - TC] + (((1 - p)*q)/(1 + q))*S[t - TC] + id*(1 - p)*FK[t - TC] - il*(1 - p)*LK[t - TC] + id*FH[t - TC] - il*LH[t - TC] + BH[t]
FK[t_] := FK[t - 1] + S[t - 1]/(1 + q) + p*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) - C[t - 1] + BK[t - 1]
FH[t_] := FH[t - 1] + k*C[t - 1] + (1 - p)*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) + id*FH[t - 1] - il*LH[t - 1] - (k*C[t - 1 - TC] + (1 - p)*((q/(1 + q))*S[t - 1 - TC] + id*FK[t - 1 - TC] - il*LK[t - 1 - TC]) + id*FH[t - 1 - TC] - il*LH[t - 1 - TC]) + BH[t - 1]
P[t_] := C[t - TP]
Q[t_] := Q[t - 1] + C[t - 1] - P[t - 1]
X[t_] := X[t - 1] + P[t - 1] - 1/(1 + q)*S[t - 1]
gBK[t_] := 0.03 + 0.5*r[t] - 0.2*il
gBH[t_] := 0.05 - 0.05*q - 0.01*il
BK[t_] := (1 + gBK[t - 1])*BK[t - 1]
BH[t_] := (1 + gBH[t - 1])*BH[t - 1]
LK[t_] := LK[t - 1] + BK[t - 1]
LH[t_] := LH[t - 1] + BH[t - 1]
r[t_] := (q/(1 + q)*S[t])/(Q[t] + X[t])
Then I run the following:
ListPlot[Map[C, period]]
And I never get the result once the period goes beyond 12. Thank you!
Two observations about your code:
1) Don't start your symbols' names with uppercase. The convention is that only System defined symbols start with uppercase (and you fell into the trap with C[n])
2) Learn about memoization. It's needed for recursive definitions going faster (that is your case).
Here you have your (modified) code running instantaneously:
p = 0.7;
q = 0.2;
k = 0.3;
id = 0.05;
il = 0.1;
TP = 3;
TP = 3;
TC = 1;
TF = 3;
Q[0] = Q[1] = Q[2] = 1;
X[0] = X[1] = X[2] = 1;
FK[0] = FK[1] = FK[2] = 1;
FH[0] = FH[1] = FH[2] = 1;
S[0] = S[1] = S[2] = 0.5;
c[0] = c[1] = c[2] = 0.5;
P[0] = P[1] = P[2] = 0.5;
BK[0] = BK[1] = BK[2] = 0.1;
BH[0] = BH[1] = BH[2] = 0.1;
LK[0] = LK[1] = LK[2] = 1;
LH[0] = LH[1] = LH[2] = 1;
r[0] = r[1] = r[2] = 0.1;
c[t_] := c[t] = ((1 + p*q)/(1 + q))*S[t - TF] + p*id*FK[t - TF] -
p*id*LK[t - TF] + BK[t]
S[t_] := S[t] = (1 - k)*c[t] +
k*c[t - TC] + (((1 - p)*q)/(1 + q))*S[t - TC] +
id*(1 - p)*FK[t - TC] - il*(1 - p)*LK[t - TC] + id*FH[t - TC] -
il*LH[t - TC] + BH[t]
FK[t_] := FK[t] = FK[t - 1] + S[t - 1]/(1 + q) +
p*((q/(1 + q))*S[t - 1] + id*FK[t - 1] - il*LK[t - 1]) - c[t - 1] + BK[t - 1]
FH[t_] := FH[t] = FH[t - 1] +
k*c[t - 1] + (1 - p)*((q/(1 + q))*S[t - 1] + id*FK[t - 1] -
il*LK[t - 1]) + id*FH[t - 1] - il*LH[t - 1] - (k*
c[t - 1 - TC] + (1 - p)*((q/(1 + q))*S[t - 1 - TC] +
id*FK[t - 1 - TC] - il*LK[t - 1 - TC]) + id*FH[t - 1 - TC] -
il*LH[t - 1 - TC]) + BH[t - 1]
P[t_] := P[t] = c[t - TP]
Q[t_] := Q[t] = Q[t - 1] + c[t - 1] - P[t - 1]
X[t_] := X[t] = X[t - 1] + P[t - 1] - 1/(1 + q)*S[t - 1]
gBK[t_] := 0.03 + 0.5*r[t] - 0.2*il
gBH[t_] := 0.05 - 0.05*q - 0.01*il
BK[t_] := BK[t] = (1 + gBK[t - 1])*BK[t - 1]
BH[t_] := BH[t] = (1 + gBH[t - 1])*BH[t - 1]
LK[t_] := LK[t] = LK[t - 1] + BK[t - 1]
LH[t_] := LH[t] = LH[t - 1] + BH[t - 1]
r[t_] := (q/(1 + q)*S[t])/(Q[t] + X[t])
Then
ListPlot[c /# Range[3, 60]]
I would like to know whats wrong with my code. I am trying to solve system of non-linear equations (initially in wolfram but the command was too long) in Mathematica:
Reduce[Pi*(h^2 + 2*R*(R - r))/sqrt (h^2 + (R - r)^2) - 2*x*Pi/3*h*R -
x*Pi/3*h*r == 0 &&
Pi*(h^2 + 2*r*(r - R))/sqrt (h^2 + (R - r)^2) + 2*Pi*r -
x*Pi/3*h*R - 2*x*Pi/3*h*r == 0 &&
Pi*h*(r + R)/sqrt (h^2 + (R - r)^2) - x*Pi/3*R^2 - x*Pi/3*R*r -
x*Pi/3*r^2 == 0 && -Pi/3*h*(R^2 + R*r + r^2) + 1 == 0, {R, r, h,
x}];
Do you know how to retype it and solve these equations? I tried to type it according to documentation, but I evidently made some mistake...
These are the original equations (in LaTeX, I dont know if they will show correctly here:
\begin{equation*}
\frac{\partial}{\partial R} L(R, r, h, \lambda) = \frac{\pi(h^2 + 2R(R-r))}{\sqrt{h^2 + (R - r)^2}} - 2\lambda \frac{\pi}{3}hR - \lambda \frac{\pi}{3}hr= 0
\end{equation*}
\begin{equation*}
\frac{\partial}{\partial r} L(R, r, h, \lambda) = \frac{\pi(h^2 + 2r(r-R))}{\sqrt{h^2 + (R - r)^2}} + 2\pi r - \lambda \frac{\pi}{3}hR - 2\lambda \frac{\pi}{3}hr= 0
\end{equation*}
\begin{equation*}
\frac{\partial}{\partial h} L(R, r, h, \lambda) = \frac{\pi h(r + R)}{\sqrt{h^2 + (R - r)^2}} - \lambda \frac{\pi}{3}R^2 - \lambda \frac{\pi}{3}Rr - \lambda \frac{\pi}{3}r^2= 0
\end{equation*}
\begin{equation*}
\frac{\partial}{\partial \lambda} L(R, r, h, \lambda) = - \frac{\pi}{3} h (R^2 + Rr + r^2) + 1 = 0
\end{equation*}
edit:
I corrected pi to PI, now it started evaluating so maybe it was the mistake...It just takes a very long time...
You have to learn at least the basics. Go to Help->Documentation Center and click on the book in the search bar. There is everything explained from the very start.
As already pointed out in the comments, all functions and built-in symbols start with a capital letter. Therefore your call should be
Reduce[Pi*(h^2 + 2*R*(R - r))/Sqrt[h^2 + (R - r)^2] - 2*x*Pi/3*h*R -
x*Pi/3*h*r == 0 &&
Pi*(h^2 + 2*r*(r - R))/Sqrt[h^2 + (R - r)^2] + 2*Pi*r -
x*Pi/3*h*R - 2*x*Pi/3*h*r == 0 &&
Pi*h*(r + R)/Sqrt[h^2 + (R - r)^2] - x*Pi/3*R^2 - x*Pi/3*R*r -
x*Pi/3*r^2 == 0 && -Pi/3*h*(R^2 + R*r + r^2) + 1 == 0, {R, r, h,
x}]
I determine limits as limit(0)=0; limit(y)=2*1.08^(y-1), y∈{1,2,3,...,50} or if you prefeer iterative functions:
limit(0)=0
limit(1)=2
limit(y)=limit(y-1)*1.08, x∈{2,3,4,...,50}
Exmples:
limit(1) = 2*1.08^0 = 2
limit(2) = 2*1.08^1 = 2.16
limit(3) = 2*1.08^2 = 2.3328
...
for a given x∈[0,infinity) I want an efficient formula to calculate y so that limit(y)>x and limit(y-1)≤x or 50 if there is none.
Any ideas?
or is pre-calculating the 50 limits and using a couple of ifs the best solution?
I am using erlang as language, but I think it will not make much of a difference.
limit(y) = 2 * 1.08^(y-1)
limit(y) > x >= limit(y - 1)
Now if I haven't made a mistake,
2 * 1.08^(y - 1) > x >= 2 * 1.08^(y - 2)
1.08^(y - 1) > x / 2 >= 1.08^(y - 2)
y - 1 > log[1.08](x / 2) >= y - 2
y + 1 > 2 + ln(x / 2) / ln(1.08) >= y
y <= 2 + ln(x / 2) / ln(1.08) < y + 1
Which gives you
y = floor(2 + ln(x / 2) / ln(1.08))