Pergunta sobre como traçar uma curva e linhas tangentes

Question

Esta é uma questão do Mathematica.

Eu tenho uma função $y=x^3$. “Fun1” é qualquer ponto da curva. No ponto Fun1, desenhe uma linha tangente nesse ponto da curva.

Em outro ponto onde a curva e a tangente se cruzam, preciso marcá-la com "Fun2". A área entre o segmento Fun1Fun2 e a curva deve ser indicada como "A"

Agora eu preciso encontrar no ponto Fun2, a linha tangente, e esta tangente cruza a curva novamente em "Fun3". A área entre o segmento Fun2Fun3 e a curva deve ser indicada como "B"

Eu acho que isso é semelhante ao problema da linha tangente

Isso é o que fiz até agora.

Considerei um ponto (2,8) para FUN1. Devo considerar as coordenadas xey? A fórmula que me foi dada para encontrar uma tangente não inclui a coordenada y (f [x0] + f '[x0] (x -x0)). Algo aqui está incorreto? Como posso mostrar FUN 2 e encontrar suas coordenadas para encontrar 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}]]

Answer 1

Eu abordaria esse problema definindo as funções derivada e tangente de maneira um pouco diferente. Eu também elaboraria um bom conjunto de interseções das tangentes com a curva antes de fazer qualquer plotagem. Igual a:

Definições básicas

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

Encontrando pontos de interseção

Começando com x0 = 1.2base no meu conhecimento de x^3como é.

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

{{x -> -2.4}, {x -> 1.2}, {x -> 1.2}}

Então, x1 = -2.4e agora é usado para encontrar x2.

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

{{x -> -2.4}, {x -> -2.4}, {x -> 4.8}}

Fazendo o enredo

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}]]

Answer 2

Você fez bem, sem erro. Apenas x2 é escolhido, de modo que "Fun3" está bem abaixo na direção -y. Escolha x0 = 1 para torná-lo mais simples:

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}]}]

Answer 3

Você pode usar MeshFunctionspara encontrar e marcar as interseções da curva com a linha tangente selecionada:

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]]

e pós-processamento para injetar os rótulos:

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

Como alternativa, combine as duas etapas em uma única etapa usando a opção DisplayFunctionde fazer o pós-processamento interno 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}]}] &)]]

Nota: Na versão 11.3.0, substitua xna última linha por x[[;;;;2]].

Atualização: Também podemos injetar os rótulos usando a opção MeshStyle. Este truque antigo (usando uma função como MeshStyleconfiguração) ainda funciona na versão 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]}]}]]