{NotebookFileName[],DateString[]}

style[
t_
]:=
Style[t,Bold,FontSize->14,FontFamily->"Arial"]

cmarker[
size_:10,
pos_:{0,0}
]:=Graphics[Circle[pos],ImageSize->size];
cmarker[]

dmarker[
size_:10,
pos_:{0,0}
]:=Graphics[Disk[pos],ImageSize->size];
dmarker[]

$Assumptions={x∈Reals}

Mobius lesson

f1[
x_
]:=
x-(Sqrt[x])

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

Plot[{f1[x],f1'[x]},{x,0,1}
,PlotLegends->style/@{f[x]==f1[x], f'[x]==D[f1[x],x]}
]

f2[
x_
]:=
((x^3)/(2-x))

Plot[{f2[x],f2'[x]},{x,-1,4}
,PlotLegends->"Expressions"
]

First derivative test

p1[
x_
]:=
(x+1)Abs[x]

Plot[Evaluate[{
p1[x],
p1'[x]/.Abs'[x]->Sign[x]
}],{x,-1,1}
,PlotLegends->style/@{"f(x)=|x|(1-x)","f'(x)"}
]

Curves with all derivatives 0

s0[
x_
]:=
(E^(-1/(x^2)))

s0[
x_/;x==0
]:=0

s0[0]

Plot[s0[x],{x,-1,1}
,PlotLegends->style/@{"s(x)"}
]

Plot[Evaluate[{
x s0[x],
D[x s0[x],x]
}],{x,-1,1}
,PlotLegends->style/@{"x s(x)", "(x s(x)())'"}
,PlotRange->{-s0[-1],s0[1]}
]

Plot[s0[x],{x,-1,1}
,Epilog->{
Inset[Graphics[cmarker[]],{0,0},{0,0},Background->White]
}
]

Plot[s0[x],{x,-10,10}
,PlotRange->{0,1}
]

Showing that all derivatives exist at 0 and are 0:

Table[
Limit[((D[s0[x],{x,n}])/x),x->0],
{n,0,20}
]

Table[
D[s0[x],{x,n}],
{n,0,5}
]//Simplify

Solve[0==D[s0[x],{x,2}],x]

s0[x]/.Solve[0==D[s0[x],{x,2}],x]

Plot[x s0[x],{x,-1,1}
]

Plot[{x,x s0[x]},{x,-5,5}
,PlotLegends->"Expressions"
]

Table[
D[x s0[x],{x,n}],
{n,0,5}
]//Simplify

Block[{c=0.5,xmin=-1,xmax=1, dx=0.5, m,mm,pc,p1,p2},
m=s0'[c];
mm=s0''[c];
pc={c,s0[c]};
p1=pc-{(dx/2),m(dx/2)};
p2=pc+{(dx/2),m(dx/2)};
Plot[s0[x],{x,xmin,xmax}
,PlotLegends->style/@{"s(x)"}
,PlotRange->{Automatic,{-0.05,All}}
,Epilog->{
PointSize[Large],Thick,
Red,
Point[{pc}],
Line[{p1,p2}],
Text[style["c = "<>ToString[c]],pc,{1,-3}],
Text[style["s''(c) = "<>ToString[mm]],pc,{1,-1}]
}
]
]

Block[{c=0,xmin=-1,xmax=1, dx=2, m,pc,p1,p2},
m=0;
mm=0;
pc={c,s0[c]};
p1=pc-{(dx/2),m(dx/2)};
p2=pc+{(dx/2),m(dx/2)};
Plot[s0[x],{x,xmin,xmax},
PlotLegends->style/@{"s(x)"},
Epilog->{
PointSize[Large],Thick,
Red,
Point[{pc}],
Line[{p1,p2}],
Text[style["c = "<>ToString[c]],pc,{1,-3}],
Text[style["s''(c) = "<>ToString[mm]],pc,{1,-1}]
}
]
]

Block[{c=1.5,xmin=-1,xmax=3, dx=1, m,pc,p1,p2},
m=s0'[c];
mm=s0''[c];
pc={c,s0[c]};
p1=pc-{(dx/2),m(dx/2)};
p2=pc+{(dx/2),m(dx/2)};
Plot[s0[x],{x,xmin,xmax},
PlotLegends->style/@{"s(x)"},
Epilog->{
PointSize[Large],Thick,
Red,
Point[{pc}],
Line[{p1,p2}],
Text[style["c = "<>ToString[c]],pc,{1,-3}],
Text[style["s''(c) = "<>ToString[mm]],pc,{1,-1}]
}
]
]

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

Block[{c=(Sqrt[(2/3)]),xmin=-1,xmax=2, dx=1, m,pc,p1,p2},
m=s0'[c];
mm=s0''[c];
pc={c,s0[c]};
p1=pc-{(dx/2),m(dx/2)};
p2=pc+{(dx/2),m(dx/2)};
Plot[s0[x],{x,xmin,xmax},
PlotLegends->style/@{"s(x)"},
Epilog->{
PointSize[Large],Thick,
Red,
Point[{pc}],
Line[{p1,p2}],
Text[style["c = (Sqrt[(2/3)])"],pc,{1,-2}],
Text[style["s''(c) = "<>ToString[mm]],pc,{1,-1}]
}
]
]

Block[{c=-(Sqrt[(2/3)]),xmin=-2,xmax=1, dx=1, m,pc,p1,p2},
m=s0'[c];
mm=s0''[c];
pc={c,s0[c]};
p1=pc-{(dx/2),m(dx/2)};
p2=pc+{(dx/2),m(dx/2)};
Plot[s0[x],{x,xmin,xmax},
PlotLegends->style/@{"s(x)"},
Epilog->{
PointSize[Large],Thick,
Red,
Point[{pc}],
Line[{p1,p2}],
Text[style["c = (Sqrt[(2/3)])"],pc,{1,-2}],
Text[style["s''(c) = "<>ToString[mm]],pc,{1,-1}]
}
]
]

Another critical point that fails the first derivative test

f3[
x_
]:=
2x+Abs[x]

FullSimplify[f3'[x]]

Plot[Evaluate@{f3[x],FullSimplify[f3'[x]]},{x,-1,1}
,PlotLegends->style/@{"f(x)=2x+|x|","f'(x)"}
]

MVT

D[ArcTan[x],x]

FindRoot[ArcTan[2]-ArcTan[1]==(1/((c^2)+1)), {c,1.5}]

Solve[ArcTan[2]-ArcTan[1]==(1/((c^2)+1)),c]

c2=Select[c/.Solve[ArcTan[2]-ArcTan[1]==(1/((c^2)+1)),c],1<#<2&][[1]]

N[c2]

Block[{a=1,b=2,c=c2,f=ArcTan,expand=1.2,xmin,xmax,tanline},
xmin=((a+b)/2)-expand((b-a)/2);
xmax=((a+b)/2)+expand((b-a)/2);
tanline=(x|->f'[c](x-c)+f[c]);
Plot[{
f[x],
tanline[x]
},{x,xmin,xmax}
,PlotStyle->{Automatic,Red}
,PlotLegends->{"arctan(x)","tangent line at c≈1.45189"}
,Epilog->{
PointSize[Large],
Point[{{a,f[a]},{b,f[b]}}],
Line[{{a,f[a]},{b,f[b]}}],
Red,
Point[{{c,f[c]}}]
}
]
]

Concavity