Mathematica Asked on October 9, 2020
I encountered a problem in solving the math problem in China’s 2019 postgraduate entrance examination.
I need to judge whether $f(x)=left{begin{array}{cc}
x|x|, & x leq 0
x ln x, & x>0
end{array}right. $ is differentiable at the point x = 0 and whether it is an extreme point.
The code in this post can be used to judge whether it is differentiable or not:
differentiableQ[f_, spec : (v_ -> v0_)] :=
With[{jac = D[f, {v}]},
Module[{f0, jac0}, {f0, jac0} = {f, jac} /. Thread[spec];
VectorQ[Flatten@{f0, jac0}, NumericQ] &&
Limit[(f - f0 - jac0.(v - v0))/Sqrt@Total[(v - v0)^2], spec] ===
0] /; VectorQ[jac]];
ClearAll[differentiableQ, dLimit];
differentiableQ[f_, spec : (v_ -> v0_)] :=
With[{jac = D[f, {v}]},
Module[{f0, jac0, res}, {f0, jac0} = {f, jac} /. Thread[spec];
If[VectorQ[Flatten@{f0, jac0}, NumericQ],
res = Limit[(f - f0 - jac0.(v - v0))/Sqrt@Total[(v - v0)^2],
spec] /.
HoldPattern[Limit[df_, s_]] /; ! FreeQ[df, Piecewise] :>
With[{L = dLimit[df, s]}, L /; FreeQ[L, dLimit]];
res =
FreeQ[res, Indeterminate] && And @@ Thread[Flatten@{res} == 0],
res = False]] /; VectorQ[jac]];
dLimit[df_, spec_] :=
Module[{f0, jac0, pcs = {}, z, res},
pcs = Replace[(*Solve[..,Reals] separates PW fn*)
z /. Solve[z == df, z,
Reals], {ConditionalExpression[y_, c_] :> {y, c},
y_ :> {y, True}}, 1];
If[ListQ[pcs],
res = (Limit[Piecewise[{#}], spec] /.
HoldPattern[Limit[Piecewise[{{y_, _}}, 0], s_]] :>
With[{L = Limit[y, s]}, L /; FreeQ[L, Limit]] & /@ pcs)];
res /; ListQ[pcs]];
f[x_] := Piecewise[{{x*RealAbs[x], x <= 0}, {x*Log[x], x > 0}}]
differentiableQ[f[x], {x} -> {0}]
Now I want to judge whether the point x = 0 is the extreme point of function $f(x)=left{begin{array}{cc}
x|x|, & x leq 0
x ln x, & x>0
end{array}right. $ .
However, MMA has no built-in function to determine whether a point is an extreme point. How to define a custom function to determine the extreme point?
Since Abs
cannot be differentiated and you are dealing with real x
, either change Abs[x]
to Sqrt[x^2]
Clear["Global`*"]
f[x_] = Piecewise[{{x*Abs[x], x <= 0}, {x*Log[x], x > 0}}] /.
Abs[real_] :> Sqrt[real^2];
f'[x] // FullSimplify
Or, alternatively use RealAbs
f2[x_] = Piecewise[{{x*RealAbs[x], x <= 0}, {x*Log[x], x > 0}}];
f2'[x]
Consequently, the derivative is not defined at x == 0
Graphically,
Plot[{f'[x], f[x]}, {x, -2, 2},
PlotLegends -> Placed["Expressions", {0.7, 0.3}]]
Answered by Bob Hanlon on October 9, 2020
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP