TransWikia.com

How can I add the tangent line from Fun 2 to Fun 3 to this function?

Mathematica Asked by Qy Ln on January 3, 2021

Question: I need to move the point Fun1 to 10 positions in the interval [-3,0), and have the drawing updated each time (including the tangent and intersection points).

I don’t know how to add Fun2-Fun3 to the drawing. Is what is done on the bottom correct? The Manipulate function only shows the tangent line from fun 1 to fun 3

ClearAll[f, t, P, PO]
f[x_] := x^3
df[x_] = f'[x];
tan[x_, x0_] := f[x0] + df[x0] (x - x0)
NSolve[tan[x, 1.2] == f[x], x]
NSolve[tan[x, -2.4] == f[x], x]

(*these are the two tangent lines, this is what I want too show in my Manipulate function, the line Fun1Fun2 shows up but the line FUn2Fun3 doesnt*)
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}]]


ClearAll[f, t, P, PO]

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


With[{x0 = 2}, 
 Plot[{f@x, t[x0]@x, ConditionalExpression[t[x0]@x, x <= x0]}, {x, -5,
    5}, PlotRange -> {{-5, 5}, {-80, 80}}, 
  Filling -> {1 -> {{3}, {None, LightBlue}}}, 
  PlotStyle -> {Automatic, Automatic, None}, ImageSize -> Large, 
  MeshFunctions -> {# &, f@# - t[x0]@# &}, Mesh -> {{x0}, {0}}, 
  MeshStyle -> Directive[PointSize@Large, Red], 
  DisplayFunction -> (Show[#, 
      Epilog -> 
       First@Cases[Normal@#, 
         p_Polygon :> 
          Text[Style[Column[{"area:", Area[p]}, Alignment -> Center], 
            14], RegionCentroid[p]], All]] &)]]

Manipulate[
 Plot[{f@x, t[x0]@x, 
   ConditionalExpression[t[x0]@x, -8 < x <= x0]}, {x, -8, 5}, 
  PlotRange -> {{-8, 8}, {-220, 70}}, 
  Filling -> {1 -> {{3}, {None, LightBlue}}}, 
  PlotStyle -> {Automatic, Automatic, None}, ImageSize -> Large, 
  MeshFunctions -> {# &, f@# - t[x0]@# &}, Mesh -> {{x0}, {0}}, 
  MeshStyle -> Directive[PointSize[Large], Red], 
  DisplayFunction -> (Show[#, 
      Epilog -> {Text[
           Style[Round[#, .1], 16, Black], #, {-1, 3/2}] & /@ 
         Cases[Normal@#, Point[x_] :> x, All][[;; 2]]}, 
      PlotLabel -> 
       Style[PromptForm["shaded area", 
         First@Cases[Normal@#, p_Polygon :> Area[p], All]], 
        20]] &)], {{x0, 2}, 0, 3, .1}]```

One Answer

I don' t understand what you are asking.

Your method of calculating the area is somewhat inaccurate.

Clear["Global`*"]

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

The curves intersect when

Solve[f[x] == t[x0][x], x] // Union

(* {{x -> -2 x0}, {x -> x0}} *)

The area between the curves is

area[x0_ /; 0 <= x0 <= 3] := Area@ImplicitRegion[
    y <= f[x] && y >= t[x0][x] && -2 x0 <= x < x0, {x, y}];

Manipulate[
 Plot[
  Evaluate[
   Tooltip /@ {ConditionalExpression[f@x, -2 x0 <= x <= x0], f@x, 
     ConditionalExpression[t[x0]@x, -2 x0 <= x <= x0], t[x0]@x}],
  {x, -8, 5},
  PlotRange -> {{-8, 5}, {-220, 70}},
  Frame -> True,
  Filling -> {1 -> {{3}, {None, LightBlue}}},
  PlotStyle -> {Automatic, {Dashed, ColorData[97][1]},
    ColorData[97][2], {Dashed, ColorData[97][2]}},
  ImageSize -> is,
  PlotRangePadding -> Scaled[.09],
  PlotLabel ->
   Style[StringForm["shaded area = ``", Round[area[x0], 0.01]], 20],
  Epilog -> {
    Text[Style[{#, Round[f@#, 0.1]}, 16], {#, f@#}, {-1, 3/2}] & /@ {-2 x0, 
      x0},
    Red, AbsolutePointSize[6],
    Point[{#, f@#} & /@ {-2 x0, x0}]}],
 {{x0, 2}, 0, 3, .1, Appearance -> "Labeled"},
 Row[{
   Control[{{is, Medium, "ImageSize"}, {Medium, Large}}],
   Spacer[50],
   Button["Reset", x0 = 2]}]]

enter image description here

Correct answer by Bob Hanlon on January 3, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP