4
$\begingroup$

This is a Mathematica question.

I have a function $y=x^3$. “Fun1” is any point on the curve. At the point Fun1, draw a tangent line at that point to the curve.

At another point where the curve and the tangent intersect I need to mark it with “Fun2”.The area between the segment Fun1Fun2 and the curve should be denoted "A”

Now I need to find at point Fun2, the tangent line, and this tangent intersects the curve again at "Fun3". The area between the segment Fun2Fun3 and the curve should be denoted "B”

I think this is similar to the Tangent Line problem

This is what I did so far.

I considered a point (2,8) for FUN1. Am I supposed to consider both x and y coordinate? The formula I was given for finding a tangent doesn’t include the y coordinate(f[x0] + f'[x0] (x -x0)). Is something here incorrect? How can I show FUN 2 and find its coordinates to find FUN3?

f[x_] := x^3 ;
x0 = 2;
l[x_] := f[x0] + f'[x0] (x - x0);
Plot[{f[x], l[x]}, {x, -8, 8}, 
  Mesh -> {{x0}}, 
  MeshStyle -> Red, 
  PlotRange -> {{-8, 8}, {-1, 15}}, 
  Epilog -> Text["FunOne", {x0, f[x0]} + {1, .1}]]
$\endgroup$
4
$\begingroup$

I would approach this problem by defining the derivative and tangent functions a little differently. I would also work out a good set of intersections of the tangents with the curve before doing any plotting. Like so:

Basic definitions

f[x_] := x^3;
df[x_] = f'[x];
tan[x_, x0_] := f[x0] + df[x0] (x - x0)

Finding intersection points

Starting with x0 = 1.2 based on my knowledge of what x^3 looks like.

With[{x0 = 1.2}, NSolve[tan[x, x0] == f[x], x]]
{{x -> -2.4}, {x -> 1.2}, {x -> 1.2}}

So x1 = -2.4 and it is now used to find x2.

With[{x1 = -2.4}, NSolve[tan[x, x1] == f[x], x]]
{{x -> -2.4}, {x -> -2.4}, {x -> 4.8}}

Making the plot

Module[{x, pts, names, offsets, ptlbls, arealbls},
  x[0] = 1.2; x[1] = -2.4; x[2] = 4.8;
  pts = {{x[0], f[x[0]]}, {x[1], f[x[1]]}, {x[2], f[x[2]]}};
  names = {"Fun1", "Fun2", "Fun3"};
  offsets = {{10, -10}, {10, -10}, {-15, 3}}; 
  ptlbls = MapThread[Text[#1, Offset[#2, #3]] &, {names, offsets, pts}];
  arealbls = {
    Text["A", Offset[{-20, 2}, (pts[[1]] + pts[[2]])/2]],
    Text["B", Offset[{0, -35}, (pts[[2]] + pts[[3]])/2]]}; 
  Plot[Evaluate@{f[x], tan[x, x[0]], tan[x, x[1]]}, {x, -3, 5},
    Epilog -> {ptlbls, {Red, AbsolutePointSize[5], Point[pts]}, arealbls}]]

plot

$\endgroup$
5
  • $\begingroup$ @QyLn/ I'm glad you find my answer useful. However, you should not ask a new question as a comment to an answer. Questions should focus on a single issue, so you should start ask your question about area in a new post. You can refer to this question or, more specifically, this answer in your new post. Further, as it is posed here, the area question is unclear. Two points do not enclose an area. $\endgroup$ – m_goldberg Nov 13 '20 at 20:29
  • $\begingroup$ thank you for letting me know! i will delete my question and make a new question! $\endgroup$ – Qy Ln Nov 13 '20 at 20:32
  • $\begingroup$ @QyLn. Don't delete this question. It is a perfectly good question. Just ask about the area computation in new question. $\endgroup$ – m_goldberg Nov 13 '20 at 20:34
  • $\begingroup$ Can I use your code? How can I reference you in my new post? $\endgroup$ – Qy Ln Nov 13 '20 at 20:37
  • $\begingroup$ @QyLn. Certainly. Just make a reference to my answer by linking you new post to this question. Click on the share button under the question to make a copy of the URL. $\endgroup$ – m_goldberg Nov 13 '20 at 20:43
4
$\begingroup$

You did well, no error. Only x2 is chosen, so that "Fun3" is way down in the -y direction. Choose x0=1 to make it simpler:

f[x_] := x^3;
x0 = 1;
l[x_] := f[x0] + f'[x0] (x - x0);
x2 = x /. Solve[l[x] == x^3, x][[1]];
Plot[{f[x], l[x]}, {x, -8, 8}, Mesh -> {{x0, x2}}, MeshStyle -> Red, 
 PlotRange -> {{-8, 8}, {-15, 15}}, 
 Epilog -> {Text["Fun1", {x0, f[x0]} + {1, .1}], 
   Text["Fun2", {x2, f[x2]} + {1, .1}]}]

enter image description here

$\endgroup$
3
  • $\begingroup$ thank you, how can i show point FUN2, on the curve where it intresects? $\endgroup$ – Qy Ln Nov 13 '20 at 16:02
  • $\begingroup$ Epilog -> Text["Funtwo", {x0, f[x0] == l[x0]} + {1, .1}] i added ths but it doesn't show up in my graph $\endgroup$ – Qy Ln Nov 13 '20 at 16:53
  • $\begingroup$ From: Solve[l[x] == x^3, x] you get the x coordinates of Fun2 :x2=-2 . Epilog reads now: {Text["Fun1", {x0, f[x0]} + {1, .1}], Text["Fun2", {x2, x2^3} + {1, .1}]}. I updated my answer $\endgroup$ – Daniel Huber Nov 13 '20 at 19:42
3
$\begingroup$

You can use MeshFunctions to find and mark the intersections of the curve with the selected tangent line:

ClearAll[f, t]
f[x_] := x^3
t[x0_][x_] := f[x0] + f'[x0] (x - x0)

plot = With[{x0 = 2}, Plot[{f @x , t[x0]@x}, {x, -5, 5},
   PlotRange -> {{-5, 5}, {-80, 80}}, 
   MeshFunctions -> {# &, f @ # - t[x0] @ # &}, 
   Mesh -> {{x0}, {0}}, 
   MeshStyle -> Directive[PointSize @ Large, Red],
   ClippingStyle -> False]]

enter image description here

and post-process to inject the labels:

plot /. Point[x_] :> {Point[x], 
   MapThread[Text[Style[#, 16, Black], #2, {1, -3/2}] &, {{"fun1", "fun2"}, x}]}

enter image description here

Alternatively, combine the two steps in a single step using the option DisplayFunction to do the post-processing inside Plot:

With[{x0 = 2}, Plot[{f @x , t[x0]@x}, {x, -5, 5},
  PlotRange -> {{-5, 5}, {-80, 80}}, 
  MeshFunctions -> {# &, f@# - t[x0]@# &}, Mesh -> {{x0}, {0}}, 
  MeshStyle -> Directive[PointSize[Large], Red],
  ClippingStyle -> False, 
  DisplayFunction -> (Show[# /. Point[x_] :> {Point[x], 
   MapThread[Text[Style[#, 16, Black], #2, {1, -3/2}] &, 
     {{"fun1", "fun2"}, x}]}] &)]]

enter image description here

Note: In version 11.3.0 replace x in the last line with x[[;;;;2]].

Update: We can also inject the labels using the option MeshStyle. This old trick (using a function as the MeshStyle setting) still works in version 12.1.2:

meshStyle = {PointSize[Large], Red, #, 
   If[# === {}, {}, 
     MapThread[Text[Style[#, 16, Black], #2, {1, -3/2}] &, 
        {{"fun1", "fun2"}, #[[1]]}]]} &;

With[{x0 = 2}, Plot[f[x], {x, -5, 5}, 
    MeshFunctions -> {# &, f[#] - t[x0][#] &}, Mesh -> {{x0}, {0}}, 
    ClippingStyle -> False,   
    MeshStyle -> meshStyle,
    PlotRange -> {{-5, 5}, {-80, 80}}, 
    Epilog -> {Orange, InfiniteLine[{x0, f@x0}, {1, f'[x0]}]}]]  

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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