f[x_]=-x+((x^2)/2)+((x^3)/3)

Factor[%]

Solve[%==0,x]

N[%]

{q1,q2,q3}={%%[[1,1,2]],%%[[2,1,2]],%%[[3,1,2]]}

{p[1],p[2],p[3]}={{q1,0},{q2,0},{q3,0}}

f'[x]

Solve[%==0]

N[%]

{q4,q5}={%%[[1,1,2]],%%[[2,1,2]]}

{yq4,yq5}=f[%];

N[%]

{p[4],p[5]}={{q4,yq4},{q5,yq5}};

{q6,q7}={-3,2};

{yq6,yq7}=f[%]

{p[6],p[7]}={{q6,yq6},{q7,yq7}};

Solve[f''[x]==0,x]

q8=%[[1,1,2]]

yq8=f[q8]

p[8]={q8,yq8}

N[Table[p[j],{j,1,8}],2]

a=Plot[f[x],{x,-3,2},GridLines->Automatic,AspectRatio->Automatic];

Show[a,Graphics[{PointSize[Large],Red,Point[Table[p[j],{j,1,8}]],Text["{-3,1.5}",p[6]+{0.35,0.1}],Text["{-2.6,0}",p[7]+{0.25,-0.15}],Text["{-1.6,1.5}",{-1.6,1.7}],Text["{-0.5,0.58}",{-0.5,0.7}],Text["{0.62,-0.35}",{0.62,-0.5}],Text["{1.1,0}",{1.35,-0.15}],Text["{2,2.7}",{1.75,2.6}]}],ListPlot[Table[p[j],{j,1,8}],Filling->Axis,FillingStyle->{{Red,Thick},{Blue,Thick}}]]

u[x_,y_]=x-y;

b=ContourPlot[x-y,{x,-3,2},{y,-2,3},ContourShading->False,ContourLabels->True,GridLines->Automatic];

Show[b,a]

θ[t_]=u[t,f[t]]

Plot[θ[t],{t,-3,2}]

θ'[t]

Solve[%==0,t]

{p[9],p[10]}={{%[[1,1,2]],f[%[[1,1,2]]]},{%[[2,1,2]],f[%[[2,1,2]]]}}

{u1,u2}={u[%%[[1,1,2]],f[%%[[1,1,2]]]],u[%%[[2,1,2]],f[%%[[2,1,2]]]]}

minmax=ContourPlot[{x-y==u1,x-y==u2},{x,-3,2},{y,-2,3},ContourStyle->{{Blue,Thick},{Blue,Thick}}];

Show[b,a,minmax,Graphics[{PointSize[Large],Red,Point[{p[9],p[10]}]}]]

Grad[u[x,y],{x,y}]

α[t_]={t,f[t]}

c=Show[b,a,minmax,Graphics[{PointSize[Large],Red,Point[{p[9],p[10]}],Arrow[{p[9],p[9]+0.5{1,-1}}],Arrow[{p[9],p[9]+0.5α'[-2]}],Arrow[{p[10],p[10]+0.5{1,-1}}],Arrow[{p[10],p[10]+0.5α'[1]}],Text["gradu[α[-2]]",p[9]+0.5{1,-1}+{-0.25,-0.15}],Text["α'[-2]",p[9]+0.5α'[-2]+{0.25,-0.1}],Text["gradu[α[1]]",p[10]+0.5{1,-1}+{-0.25,-0.15}],Text["α'[1]",p[10]+0.5α'[1]+{0.25,-0.1}],Text["u=-10/3",p[9]+α'[-2]+{0.4,0}],Text["u=7/6",p[10]-α'[1]+{0.3,0}]}]]

Manipulate[Show[c,Graphics[{PointSize[Large],Black,Point[α[t]],Arrow[{{α[t],α[t]+0.5α'[t]},{α[t],α[t]+0.5{1,-1}}}]}]],{t,-3,2}]