Mathematica Asked on January 17, 2021
I am trying to highlight the intersection point (point, dashed lines) in the bottom diagram and the the corresponding point in the top diagram. Unfortunately, I am creating lots of error messages in the second output – coordinates from Solve and NSolve.
ClearAll[f, fp, g, x, a, b, m, intersect1, xintersect, xintersect, yintersect1, h1line, v1line, intersect2]
f[a_, x_] := a*Log[x];
fp[a_, x_] := a/x;
g[b_, m_, x_] := b + m*x;
(*Intersection Point in bottom diagram *)
intersect1[a_, b_, m_] := {x, fp[a, x]} /.
NSolve[fp[a, x] == g[b, m, x], x]
xintersect[a_, b_, m_] := Part[intersect[a, b, m], 1]
yintersect1[a_, b_, m_] := Part[intersect[a, b, m], 2]
(*Dashed lines for intersection point in bottom diagram *)
h1line[a_, b_, m_] :=
Line[{{0, yintersect1[a, b, m]}, {xintersect[a, b, m],
yintersect1[a, b, m]}}]
v1line[a_, b_, m_] :=
Line[{{xintersect[a, b, m], 0}, {xintersect[a, b, m],
yintersect1[a, b, m]}}]
(*Point in top diagram with dashed lines*)
yintersect2[a_, b_, m_] := f[a, xintersect[a, b, m]]
intersect2[a_, b_, m_] := {xintersect[a, b, m], yintersect[a, b, m]}
h2line[a_, b_, m_] :=
Line[{{0, yintersect2[a, b, m]}, {xintersect[a, b, m],
yintersect2[a, b, m]}}]
v2line[a_, b_, m_] :=
Line[{{xintersect[a, b, m], 0}, {xintersect[a, b, m],
yintersect2[a, b, m]}}]
(* Working Output*)
Manipulate[
Column[{Plot[f[a, x], {x, 0, 30}, PlotRange -> {25, 1600},
AxesLabel -> {"x", "f(x)"}],
Plot[{fp[a, x], g[b, m, x]}, {x, 0, 30}, PlotRange -> {25, 600},
Epilog -> {Blue, PointSize@Large, Point@intersect1[a, b, m]},
AxesLabel -> {"x", "f'(x), g(x)"}]}],
{{a, 400}, 1, 1500}, {{b, 50}, 0, 250}, {{m, 10}, 0, 50}]
(* Error Messages *)
Manipulate[
Column[{Plot[f[a, x], {x, 0, 30}, PlotRange -> {25, 1600},
AxesLabel -> {"x", "f(x)"},
Epilog -> {Blue, PointSize@Large, Point@intersect2[a, b, m]}],
Plot[{fp[a, x], g[b, m, x]}, {x, 0, 30}, PlotRange -> {25, 600},
Epilog -> {Blue, PointSize@Large, Point@intersect1[a, b, m]
, Dashed, h1line[a, b, m], v1line[a, b, m]},
AxesLabel -> {"x", "f'(x), g(x)"}]}],
{{a, 400}, 1, 1500}, {{b, 50}, 0, 250}, {{m, 10}, 0, 50}]
Thanks!
Clear["Global`*"]
f[a_, x_] := a*Log[x];
fp[a_, x_] := a/x;
g[b_, m_, x_] := b + m*x;
Solve
for intersect1
once rather than for each set of parameters.
(*Intersection Point in bottom diagram*)
intersect1[a_, b_, m_] = {x, fp[a, x]} /.
Assuming[Thread[{a, b, m} > 0],
Solve[{fp[a, x] == g[b, m, x], a > 0, b > 0, m > 0, x > 0}, x] //
Simplify][[1]]
(* {(-b + Sqrt[b^2 + 4 a m])/(2 m), (2 a m)/(-b + Sqrt[b^2 + 4 a m])} *)
The RHS of the next two lines should have intersect1[a, b, m]
rather than intersect[a, b, m]
xintersect[a_, b_, m_] = Part[intersect1[a, b, m], 1];
yintersect1[a_, b_, m_] = Part[intersect1[a, b, m], 2];
(*Dashed lines for intersection point in bottom diagram*)
h1line[a_, b_, m_] :=
Line[{{0, yintersect1[a, b, m]}, {xintersect[a, b, m], yintersect1[a, b, m]}}]
v1line[a_, b_, m_] :=
Line[{{xintersect[a, b, m], 0}, {xintersect[a, b, m], yintersect1[a, b, m]}}]
(*Point in top diagram with dashed lines*)
yintersect2[a_, b_, m_] := f[a, xintersect[a, b, m]]
RHS of next line should have yintersect2[a, b, m]
rather than yintersect[a, b, m]
intersect2[a_, b_, m_] := {xintersect[a, b, m], yintersect2[a, b, m]}
h2line[a_, b_, m_] :=
Line[{{0, yintersect2[a, b, m]}, {xintersect[a, b, m], yintersect2[a, b, m]}}]
v2line[a_, b_, m_] :=
Line[{{xintersect[a, b, m], 0}, {xintersect[a, b, m], yintersect2[a, b, m]}}]
Manipulate[
Column[{
Plot[f[a, x], {x, 0, 30},
PlotRange -> {25, 1600},
AxesLabel -> {"x", "f(x)"},
Epilog -> {Blue, PointSize@Large,
Point@intersect2[a, b, m]},
ImageSize -> Medium],
Plot[{fp[a, x], g[b, m, x]}, {x, 0, 30},
PlotRange -> {25, 600},
Epilog -> {
Blue, PointSize@Large, Point@intersect1[a, b, m],
Dashed, h1line[a, b, m], v1line[a, b, m]},
AxesLabel -> {"x", "f'(x), g(x)"},
ImageSize -> Medium]}],
{{a, 400}, 1, 1500, Appearance -> "Labeled"},
{{b, 50}, 1, 250, 1, Appearance -> "Labeled"},
{{m, 10}, 0.5, 50, 0.5, Appearance -> "Labeled"}]
Correct answer by Bob Hanlon on January 17, 2021
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP