3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ @CarlWoll I don't see the answer to my question on that page. $\endgroup$ – user76284 Jun 19 '17 at 2:57
  • 2
    $\begingroup$ smoothe[f][x] immediately evaluates to Sin[x]/x for a symbolic value of x. $\endgroup$ – LLlAMnYP Jun 19 '17 at 10:31
  • $\begingroup$ @LLlAMnYP Since you marked this question as a duplicate, could you point out where the linked page answers my question? $\endgroup$ – user76284 Jun 19 '17 at 17:31
  • $\begingroup$ The marked duplicate, top answer "Evaluate ((x - 2) (x + 1))/((x - 2) (x + 3)) and see what it gives. It automatically simplifies to (1 + x)/(3 + x)." In your case, see my comment immediately above yours. Your Limit[Sin[y]/y, y -> x] automatically and immediately simplifies to Sin[x]/x, before FunctionDomain works. $\endgroup$ – LLlAMnYP Jun 20 '17 at 7:44
  • 1
    $\begingroup$ I voted to reopen this question. Issue addressed here is opposite of one discussed in question marked as duplicate and requires different solution than any of presented there. $\endgroup$ – jkuczm Jun 20 '17 at 19:31
4
$\begingroup$

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  *)
$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Kellen Myers Jun 20 '17 at 21:43
  • 1
    $\begingroup$ I don't think closure[FunctionDomain[Exp[-1/x], x]] should be True $\endgroup$ – Carl Woll Jun 20 '17 at 23:57
  • $\begingroup$ @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. $\endgroup$ – Michael E2 Jun 21 '17 at 0:21
  • $\begingroup$ I think Series might be a better tool $\endgroup$ – Carl Woll Jun 21 '17 at 0:22
  • 1
    $\begingroup$ 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 $\endgroup$ – Carl Woll Jun 21 '17 at 0:28
3
$\begingroup$

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.)

$\endgroup$
  • $\begingroup$ n.b. This is philosophically the same as Bob Hanlon's answer, but with the flexibility to deal with different f. $\endgroup$ – Kellen Myers Jun 19 '17 at 5:19
  • $\begingroup$ FullSimplify[0||x!=0] evaluates to x != 0 $\endgroup$ – user76284 Jun 19 '17 at 5:56
  • $\begingroup$ Sorry, this is due to a syntax error I seem to have overlooked. Not sure where my head was, but it's fixed. $\endgroup$ – Kellen Myers Jun 19 '17 at 6:18
  • $\begingroup$ Thank you for your answer. Based on your code, I created a function called patch that patches the removable singularities in a function, and can be called directly. I have added it to the question. $\endgroup$ – user76284 Jun 20 '17 at 23:14
  • $\begingroup$ I'm glad my approach was helpful to you. $\endgroup$ – Kellen Myers Jun 22 '17 at 0:17
2
$\begingroup$

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.

$\endgroup$
1
$\begingroup$

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  *)
$\endgroup$
  • $\begingroup$ The problem is that I don't know what f will be ahead of time. $\endgroup$ – user76284 Jun 19 '17 at 2:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.