3

How can I make FunctionDomain include removable singularities? For instance,

FunctionDomain[Sinc[x], x] == True

But

FunctionDomain[Sin[x]/x, x] == x < 0 || x > 0

I would like the latter to return True as well.

EDIT: I solved the problem by creating a patch function that patches removable singularities, as described in my answer.

user76284
  • 341
  • 1
  • 11

4 Answers4

4

Maybe this can get you started. (Maybe I've forgotten something.)

ClearAll[close];  (* close each open inequality if limit exists by adding endpoint *)
close[f_, x_][x_ != a_] := 
  If[NumericQ[Limit[f, x -> a]], x == a, False];
close[f_, x_][x_ < a_] := 
  If[NumericQ[Limit[f, x -> a, Direction -> 1]], x == a, False];
close[f_, x_][x_ > a_] := 
  If[NumericQ[Limit[f, x -> a, Direction -> -1]], x == a, False];
close[f_, x_][a_ < x_] := 
  If[NumericQ[Limit[f, x -> a, Direction -> -1]], x == a, False];
close[f_, x_][a_ > x_] := 
  If[NumericQ[Limit[f, x -> a, Direction -> 1]], x == a, False];
close[f_, x_][a_ < x_ < b_] := {
   If[NumericQ[Limit[f, x -> a, Direction -> -1]], x == a, False], 
   If[NumericQ[Limit[f, x -> b, Direction -> 1]], x == b, False]};
close[f_, x_][a_ > x_ > b_] := {
   If[NumericQ[Limit[f, x -> a, Direction -> 1]], x == a, False], 
   If[NumericQ[Limit[f, x -> b, Direction -> -1]], x == b, False]};
close[f_, x_][_] := False;

$ineqheads = (Less | LessEqual | Greater | GreaterEqual | Inequality | Unequal);

SetAttributes[closure, HoldAll];
closure[FunctionDomain[f_, x_]] := closure[Evaluate@FunctionDomain[f, x], f, x];
closure[domain_, f_, x_] := 
 domain || Or @@ Flatten@
     Cases[domain, i : $ineqheads[__] :> close[f, x][i], Infinity] // 
  Simplify;

Example:

closure[FunctionDomain[Sin[x]/x, x]]
(*  True  *)
Michael E2
  • 235,386
  • 17
  • 334
  • 747
  • This closure function seems to give us a way to determine the effective domain of the OP's smoothe[f[x]] but doesn't give us a new function. Is that what you are proposing? – Kellen Myers Jun 20 '17 at 21:43
  • 1
    I don't think closure[FunctionDomain[Exp[-1/x], x]] should be True – Carl Woll Jun 20 '17 at 23:57
  • @CarlWoll No, it shouldn't. I knew that. My example is x/Abs[x]. You have to match left & right side limits, which I omitted. Any solution that relies on Limit[f, x -> c] without checking both sides will also have the same problem (i.e. all the other answers so far, too). This is one of those questions where, so far, the effort/reward ratio calls fastidiousness into question, imo. – Michael E2 Jun 21 '17 at 00:21
  • I think Series might be a better tool – Carl Woll Jun 21 '17 at 00:22
  • @CarlWoll You must have an idea that eludes me. Series on Exp[-1/x] and Exp[-1/x^2] return similar looking results. – Michael E2 Jun 21 '17 at 00:25
  • 2
    Ignoring essential singularities, if you can expand around a point without a pole, then the singularity is removable. For essential singularities, possibly you can just look at the leading term – Carl Woll Jun 21 '17 at 00:28
3

I would propose looking for the points of discontinuity ahead of time, as follows:

f[x_] = Sin[x]/x;
Excl =
 Simplify[
  Map[{Limit[f[t], t -> #], x==#} &, 
   x /. Solve[Simplify[Not[FunctionDomain[f[x], x]]], x]
   ]
  ]

(* Out = {{1, x==0}} *)

This output is "reversed" in the sense that it is the y value, then the x value, but that is the necessary format for Piecewise to be used:

g[x_] = Piecewise[Excl, f[x]];

This gives you what you want:

FunctionDomain[g[x], x]

Here's another more complicated example:

f2[x_] = Sin[x]/x + (1 - x^2)/(1 - x);
Excl2 =
  Simplify[
   Map[{Limit[f2[t], t -> #], x==#} &, 
    x /. Solve[Simplify[Not[FunctionDomain[f2[x], x]]], x]
    ]
   ];
g2[x_] = Piecewise[Excl2, f2[x]];
Simplify[FunctionDomain[g2[x], x]]
(* Out = True *)

I have no idea if this is the nicest or most compact way of doing this, but it works (I think). Here is a black box that does it:

smooth[f_] =
 Function[x,
  Piecewise[
   Simplify[
    Map[{Limit[f[t], t -> #], x == #} &, 
     x /. Solve[Simplify[Not[FunctionDomain[f[x], x]]], x]
     ]
    ],
   f[x]]
  ]

I originally had this split into two functions, but I've made an edit here, because any use of x internal to finding the excluded points won't jive with the pure function we're defining.

smooth[f][x]
FunctionDomain[%, x]
(* Out = piecewise definition of smooth[f][x] *)
(* Out = True *)
smooth[f2][x]
FunctionDomain[%, x]
(* Out = piecewise definition of smooth[f][x] *)
(* Out = True *)

Both of those give the functions as before, and again confirm that this function has the full domain you want. If you want to do anything serious besides checking the domain, you want to assign this to its own symbol, i.e.

h=smooth[f];
h[0]
(* Out = 1 *)

If you just try smooth[f][0], the function tries to do what smooth normally does while also using a fixed value of x=0. That's not going to work.

This all assumes the points of discontinuity of the function are easy enough to find -- particularly, that Solve can find them. Of course, there may be cases where that isn't the case, but I wonder if that isn't something where this entire idea would be impractical.

As to your original idea, why doesn't it work (even though the function appears to have the right domain)?

When you do the following:

f[x_] := Sin[x]/x
smoothe[g_] := Limit[g[y], y -> #] &
FunctionDomain[smoothe[f][x], x]

What the call smoothe[f] returns is the expression Sin[x]/x.

Then it finds the domain of that function, as written, which is no different than finding the domain of f[x] in the first place.

Your smoothe[f][__] will give the correct value for numerical values in the blank, but not for symbolic values -- Mathematica will evaluate the limit you've packed up into smoothe as if a symbolic x would not be the point of discontinuity.

And then, when you ask for the domain, Mathematica balks and says "Sorry, I thought this should be Sin[x]/x when I did smoothe and now the domain excludes x==0, even though smoothe[f][0] exists."

(Edit: I goofed on some syntax and some weird self-correcting errors made it hard to detect, but it's fixed.)

Kellen Myers
  • 2,701
  • 15
  • 18
2

I solved the problem by creating a patch function that patches removable singularities:

(* Returns the two-sided limit, if it exists *)

twoSidedLimit[f_, x_] := Block[{
   r = Limit[f@t, t -> x, Direction -> 1],
   l = Limit[f@t, t -> x, Direction -> -1]
   }, ConditionalExpression[r, r == l]]

(* Patches removable singularities in a function *)

patch[f_][x_] := 
 Piecewise[
  ReleaseHold@
   Cases[Reduce@! FunctionDomain[f@t, t], 
    t == c_ -> {twoSidedLimit[Hold@f, c], x == c}, {0, Infinity}], 
  f@x]

For example,

TableForm@Prepend[{
     #[x],
     FullSimplify@FunctionDomain[#[x], x],
     FullSimplify@FunctionDomain[patch[#][x], x],
     patch[#][0]
     } & /@ {
    # &
    , Piecewise[{{99, # != 0}}, Undefined] &
    , Piecewise[{{99, # == 0}}, Undefined] &
    , #*Cos[1/#] &
    , (# + #^2)/# &
    , Sin[#]/# &
    , Log[1 + #]/# &
    , Sin[#]/# + Tan[#] &
    (*,Exp[1/#]&*)
    }, {"f[x]", "dom[f]", "dom[patch[f]]", 
   "patch[f][0]"}]

outputs

{
 {"f[x]", "dom[f]", "dom[patch[f]]", "patch[f][0]"},
 {x, True, True, 0},
 {ConditionalExpression[99, x != 0], x != 0, True, 99},
 {ConditionalExpression[99, x == 0], x == 0, x == 0, 99},
 {x Cos[1/x], x != 0, True, 0},
 {(x + x^2)/x, x != 0, True, 1},
 {Sin[x]/x, x != 0, True, 1},
 {Log[1 + x]/x, -1 < x < 0 || x > 0, x > -1, 1},
 {Sin[x]/x + Tan[x], 1/2 + x/\[Pi] \[NotElement] Integers && x != 0, 
  x == 0 || 1/2 + x/\[Pi] \[NotElement] Integers, 1}
}

as desired.

user76284
  • 341
  • 1
  • 11
1

If you want the FunctionDomain to include 0 define the function accordingly

f[x_] := Sin[x]/x
f[0 | 0.] = Limit[Sin[x]/x, x -> 0];

FunctionDomain[f, x]

(*  True  *)
Bob Hanlon
  • 157,611
  • 7
  • 77
  • 198