Clear[a,b,coelho,eq1,eq2,eq3,f,fig,g1,g2,g3,g4,g5,L,retas,solucoes,tabela,x,x0]

Um carro anda por uma rodovia que tem o formato da curva y=(x^6)-7(x^4)+11(x^2)+x. Um coelho se encontra parado no ponto P=(-1,2), fora da rodovia. É noite e o carro tem seus faróis acesos. Em quais pontos da rodovia o carro iluminará o coelho?

f[x_]=x^6-7 x^4+11 x^2+x     (* esta é a função que dá y=f(x) da rodovia *)

g1=Plot[f[x],{x,-2.5,2.5},PlotRange->{-7,7}
]       (* gráfico da rodovia  *)
g2=ListPlot[{{1,-2}},PlotStyle->{Black,Large}]      (* ponto em que o coelho está  *)
Show[g1,g2]

L[x_]=a x+b        (* função que dá a reta y=L(x) que corresponde ao traçado do farol. Note que temos a e b a determinar!  *)

(*  Temos o problema de determinar a e b da reta acima, bem como o ponto (x0,f(x0)) em que o carro estará quando o coelho for iluminado; temos assim 3 incógnitas. Dessa forma, precisamos de três condições (ou equações) para determinar tais incógnitas. Essas 3 equações são as seguintes: *)

eq1=L[1]==-2                 (*  a reta deve passar pelo coelho em (-2,1)  *)
eq2=L[x0]==f[x0]        (*  a reta deve passar pelo ponto (x0,f(x0)) do gráfico, com x0 a determinar  *)
eq3=a==f'[x0]               (*  a reta deve ter coeficiente angular f'(x0) nesse ponto (x0,f(x0)) do gráfico, com x0 a determinar  *)

Solve[{eq1,eq2,eq3},{a,b,x0}]    (* Resolve analiticamente essas 3 equações para essas 3 incógnitas: a, b e x0  *)

(* O resultado acima é horrível de ser interpretado! Vamos proceder então numericamente *)

NSolve[{eq1,eq2,eq3},{a,b,x0}]     (* Resolve numericamente essas 3 equações para essas 3 incógnitas, a, b e x0  *)

(* Vemos que temos soluções imaginárias, que não correspondem a soluções válidas para o problema em questão. Vamos assim restringir o NSolve a dar apenas soluções reais:  *)

solucoes=NSolve[{eq1,eq2,eq3},{a,b,x0},Reals]

(* Podemos tabelar essas soluções usando inteligentemente o comando ReplaceAll, que abaixo é usado na forma "/.":   *)

tabela={x0,f[x0]}/.solucoes

g3=ListPlot[tabela,PlotStyle->{Red,Large}]    (* gráfico com os pontos achados para o carro *)

Show[g1,g2,g3]

(* Podemos também tabelar as retas que dão as soluções usando novamente o comando /. abaixo   *)

retas=(a x+b)/.solucoes

g4=Plot[retas,{x,-2.5,2.5},PlotStyle->Orange]  (*  gráficos com as retas encontradas  *)

Show[g4, g1,g2,g3]    (* gráfico mostrando tudo  *)

Bônus: uma animação com o que acontece ao longo do trajeto do carro (aperte o play):

fig=;
coelho=Show[fig,ImageSize->10];
g5=ListPlot[{{1,-2}},PlotMarkers->{coelho}];

Animate[Show[g1,g5,ListPlot[{{x0,f[x0]}},PlotStyle->{Red,Large},PlotRange->{-7,7}],Plot[f[x0]+f'[x0] (x-x0),{x,-2.5,2.5},PlotStyle->Orange,PlotRange->{-7,7}]],{x0,-2.5,2.5},AnimationRunning->False]

(*  O mesmo que o gráfico anterior, mas com você controlando o ponto:  *)

Manipulate[Show[g1,g5,ListPlot[{{x0,f[x0]}},PlotStyle->{Red,Large},PlotRange->{-7,7}],Plot[f[x0]+f'[x0] (x-x0),{x,-2.5,2.5},PlotStyle->Orange,PlotRange->{-7,7}]],{{x0,0},-2.5,2.5}]